Вставьте строки на основе значения ячейки и заполните

Question

В настоящее время у меня есть лист со значениями, которые выглядят следующим образом, например:

1 A     B     C     D..............
2 1     Title of item 1
3       Formulas and formatting 1
4 2     Title of item 2
5       Formulas and formatting 2
6 3     Title of item 3
7       Formulas and formatting 3

Я хочу, чтобы код просматривал столбец A. Если столбец A содержит число> 1затем он вставляет это число (-1) строк, но на 2 строки вниз.Затем мне нужно заполнить формулы (формулы нужно перетаскивать вниз) и отформатировать от строки выше до последней строки, вставленной для этого раздела.Таким образом, это выглядело бы примерно так:

1 A     B     C     D...............
2 1     Title of item 1
3       Formulas and formatting 1
4 2     Title of item 2
5       Formulas and formatting 2
6       Formulas and formatting 2
7 3     Title of item 3
8       Formulas and formatting 3
9       Formulas and formatting 3
10      Formulas and formatting 3

И так далее, и так далее ... Обратите внимание, что нужно перетаскивать формулы всех строк и форм, а не только AD ...

Я думаю, что я почти со следующим кодом, но я не могу заставить его заполнить формулы из первой строки до значения в A, пока не будет вставлена ​​последняя строка для этого раздела ....

Вот мой код:

Sub Add_Rows()
  Dim r As Long

  Application.ScreenUpdating = False
  For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If Cells(r, "A").Value > 1 Then Rows(r + 2).Resize(Cells(r, "A").Value - 1).Insert

  Next r
  Application.ScreenUpdating = True
End Sub

Если бы кто-нибудь мог помочь мне с вышеупомянутым, это было бы удивительно !!Точно так же я думаю, что мой метод может быть немного неуклюжим, поэтому я также открыт для более красноречивых решений !!Спасибо, ребята, этот форум спас мою кожу столько раз !!!Однажды я надеюсь, что смогу ответить на некоторые вопросы, вместо того, чтобы всегда задавать их!

Answer 1

Попробуй это.Вы на самом деле ничего не копируете и не вставляете.

Sub Add_Rows()

  Dim r As Long

  Application.ScreenUpdating = False

  For r = Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
    If IsNumeric(Cells(r, "A")) Then
        If Cells(r, "A").Value > 1 Then
            Rows(r + 2).Resize(Cells(r, "A").Value - 1).Insert shift:=xlDown
            Rows(r + 1).Copy
            Rows(r + 2).Resize(Cells(r, "A").Value - 1).PasteSpecial xlPasteAll
        End If
    End If
  Next r

  Application.ScreenUpdating = True
  Application.CutCopyMode = False
  Application.Goto Range("A1")

End Sub