VBA - don't copy paste data based on information

Question

I've created code that base on "add line" in column A insert row below. As example if we have in row A10 "add line" then it inserts row in A11.

Next base on this I want to copy and paste special for columns E:H in newly created row.

Code that I created you can find below. Unfortunately it works only for one position - meaning if I have "add line" in row A10, A13, A20 it copy-paste only for A11 and rest remain unchanged.

To be precise A14 should have formulas from A13 and A21 from A20. Could you guide me, what I did wrong?

Sub PasteFormulasBelowAddLine()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim addLineRows() As Long
    Dim addLineCount As Long
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Input Sheet_wo_Main Sum Lin (3)")
    
    ' Find the last row in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    
    ' Initialize variables
    addLineCount = 0
    
    ' Loop through column A to find "add line" and store row numbers in array
    For i = 1 To lastRow
        If ws.Cells(i, "A").Value = "add line" Then
            addLineCount = addLineCount + 1
            ReDim Preserve addLineRows(1 To addLineCount)
            addLineRows(addLineCount) = i
        End If
    Next i
    
    ' Paste formulas in rows below "add line"
    For i = 1 To addLineCount
        ' Check if the row below "add line" exists and is not empty
        If addLineRows(i) < lastRow Then
            ' Copy formulas from the row containing "add line"
            ws.Range(ws.Cells(addLineRows(i), "E"), ws.Cells(addLineRows(i), "H")).Copy
            ' Paste formulas into the row below
            ws.Range(ws.Cells(addLineRows(i) + 1, "E"), ws.Cells(addLineRows(i) + 1, "H")).PasteSpecial Paste:=xlPasteFormulas
            Application.CutCopyMode = False ' Clear clipboard
        End If
    Next i
End Sub

Example: Starting excel

Result

Answer 1

• Row insertion shifts all below rows. Looping should be in reverse order.
• Assign formulas is more efficient than copy/paste.

Sub PasteFormulasBelowAddLine()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long
    Dim addLineRows() As Long
    Dim addLineCount As Long
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Sheets("Input Sheet_wo_Main Sum Lin (3)")
    
    ' Find the last row in column A
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).row
    
    ' Initialize variables
    addLineCount = 0
    
    ' Loop through column A to find "add line" and store row numbers in array
    For i = 1 To lastRow
        If ws.Cells(i, "A").Value = "add line" Then
            addLineCount = addLineCount + 1
            ReDim Preserve addLineRows(1 To addLineCount)
            addLineRows(addLineCount) = i
            Debug.Print i  ' debug code
        End If
    Next i

    ' Paste formulas in rows below "add line"
    For i = addLineCount To 1 Step -1
        ' Check if the row below "add line" exists and is not empty
        If addLineRows(i) <= lastRow Then
            ws.Rows(addLineRows(i) + 1).Insert
            ' Copy formulas from the row containing "add line"
            With ws.Cells(addLineRows(i), 3)
                .Offset(1).Value = .Value ' Update Col C
            End With
            ' Update formulas on Col E:H 
            With ws.Range(ws.Cells(addLineRows(i), "E"), ws.Cells(addLineRows(i), "H"))
                .Resize(2).Formula = .Formula
            End With
        End If
    Next i
End Sub