Insert Rows and Drag Formulas Down on Multiple Sheets - VBA

[jwb1012]

Hello, I am attempting to get my code to loop through all worksheets that begin with "Labor BOE", find all numbers in column A (beginning in row 2), insert that many rows below the cell with the number, and then drag the formulas down.

For example, if cell A10 = 3, then I need 3 rows to be inserted below. But, after these rows are inserted, I need columns C-J to be dragged down.

I have everything working, except I am unable to get the formulas to drag down. Any thoughts?

Sub InsertRows()
Dim End_Row As Long, n As Long, Ins As Long
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Sheets
    If Left(sh.Name, 9) = "Labor BOE" Then
        
        End_Row = sh.Range("L" & Rows.Count).End(xlUp).Row
        
        Application.ScreenUpdating = False
        For n = End_Row To 3 Step -1
            Ins = sh.Cells(n, "A").Value
            
            If Ins > 0 Then sh.Range("A" & n + 1 & ":A" & n + Ins).EntireRow.Insert
        Next n
        
    End If
Next sh
End Sub

 

[baitmaster]

You could try this. I don't like it as it involves copy & paste which will probably fail unless you start activating worksheets etc., but see how you get on

Sub InsertRows()
Dim End_Row As Long, n As Long, Ins As Long
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Sheets
    If Left(sh.Name, 9) = "Labor BOE" Then
        
        End_Row = sh.Range("L" & Rows.Count).End(xlUp).Row
        
        Application.ScreenUpdating = False
        For n = End_Row To 3 Step -1
            Ins = sh.Cells(n, "A").Value
            
            If Ins > 0 Then
                sh.Range("A" & n + 1 & ":A" & n + Ins).EntireRow.Insert
[COLOR=#FF0000]                sh.range("C" & n & ":J" & n).copy destination:= sh.range("C" & n+1 & ":J" & n+ins)
            end if[/COLOR]
        Next n
        
    End If
Next sh
End Sub

 

[jwb1012]

Wonderful - thank you! It works perfectly now!