Code not looping through multiple sheets as intended - VBA

[jwb1012]

Hello, I am using the following code to copy/paste a range from one worksheet to multiple sheets. But, my code is only pasting the range onto the sheet that is currently open. Any thoughts on how to get it to copy paste to all sheets that begin with "Labor BOE"?

Here is the line in my code that appears to be not working/ignored:

For Each sh In ActiveWorkbook.Sheets
If Left(sh.Name, 9) = "Labor BOE" Then



Full Code:
Sub CopyPaste_Range()
Dim sh As Worksheet

'Copy Range
Sheets("Template - Tasks").Range("A20:L28").Copy

'Paste to active sheet
For Each sh In ActiveWorkbook.Sheets
If Left(sh.Name, 9) = "Labor BOE" Then

lastRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row + 1
Range("A" & lastRow).Select

ActiveSheet.Paste
End If

Next sh
Application.DisplayAlerts = True
On Error GoTo 0
End Sub

 

[Tetra201]

Leaving aside code optimization issues, here is your problem

Sub CopyPaste_Range()
Dim sh As Worksheet
      
     'Copy Range
     Sheets("Template - Tasks").Range("A20:L28").Copy
     
    'Paste to active sheet
    For Each sh In ActiveWorkbook.Sheets
    If Left(sh.Name, 9) = "Labor BOE" Then
    
[COLOR=#ff0000]sh.Select[/COLOR]

    lastRow = ActiveSheet.Cells(Rows.Count, "L").End(xlUp).Row + 1
    Range("A" & lastRow).Select
 
    ActiveSheet.Paste
    End If
    
Next sh
Application.DisplayAlerts = True
On Error GoTo 0
End Sub

 

[My Aswer Is This]

Try this:

Sub CopyPaste_Range()
Application.ScreenUpdating = False
Dim i As Long
 Dim Lastrow As Long
    For i = 1 To Sheets.Count
        If Left(Sheets(i).Name, 9) = "Labor BOE" Then
            Lastrow = Sheets(i).Cells(Rows.Count, "L").End(xlUp).Row + 1
            Sheets("Template - Tasks").Range("A20:L28").Copy Destination:=Sheets(i).Range("A" & Lastrow)
        End If
    Next
Application.ScreenUpdating = True
  
End Sub

 

[jwb1012]

Awesome!! It worked perfectly. Is it possible to copy the range onto each worksheet multiple times based on a number in cell A2 of each "Labor BOE" worksheet?

So, instead of pasting the range 1 time on each "Labor BOE" sheet, It would look at cell A2 on each "Labor BOE" sheet and paste the range on that sheet X number of times?

For example, if cell A2 = 1 on "Labor BOE 1" then it would copy the range 1 time, but if cell A2 = 2 on "Labor BOE 2" then it would copy the range on this sheet 2 times?

 

[My Aswer Is This]

Are your comments directed to my script in post # 3.

Awesome!! It worked perfectly. Is it possible to copy the range onto each worksheet multiple times based on a number in cell A2 of each "Labor BOE" worksheet?

So, instead of pasting the range 1 time on each "Labor BOE" sheet, It would look at cell A2 on each "Labor BOE" sheet and paste the range on that sheet X number of times?

For example, if cell A2 = 1 on "Labor BOE 1" then it would copy the range 1 time, but if cell A2 = 2 on "Labor BOE 2" then it would copy the range on this sheet 2 times?

 

[jwb1012]

Yes!

 

[My Aswer Is This]

OK. I will get back with you shortly

Yes!

 

[My Aswer Is This]

Try this:

Sub CopyPaste_Range()
'With number of times
Application.ScreenUpdating = False
Dim num As Long
Dim i As Long
Dim b As Long
 Dim Lastrow As Long
    For i = 1 To Sheets.Count
        If Left(Sheets(i).Name, 9) = "Labor BOE" Then
            Lastrow = Sheets(i).Cells(Rows.Count, "L").End(xlUp).Row + 1
            num = Sheets(i).Range("A2").Value
            For b = 1 To num
                Lastrow = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row + 1
                Sheets("Template - Tasks").Range("A20:L28").Copy Destination:=Sheets(i).Range("A" & Lastrow)
            Next
        
        End If
    Next
Application.ScreenUpdating = True
  
End Sub

 

[jwb1012]

Wonderful - worked perfectly, with one slight adjustment ( "+1" needed to be "+3" so it didn't delete the bottom of the range.

Sub CopyPaste_Range()
Application.ScreenUpdating = False
Dim num As Long
Dim i As Long
Dim b As Long
 Dim Lastrow As Long
    For i = 1 To Sheets.Count
        If Left(Sheets(i).Name, 9) = "Labor BOE" Then
            Lastrow = Sheets(i).Cells(Rows.Count, "L").End(xlUp).Row + 1
            num = Sheets(i).Range("L2").Value
            For b = 1 To num
                Lastrow = Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row + 3
                Sheets("Template - Tasks").Range("A20:L28").Copy Destination:=Sheets(i).Range("A" & Lastrow)
            Next
        
        End If
    Next
Application.ScreenUpdating = True
  
End Sub

 

[My Aswer Is This]

Try changing Lastrow to L instead of "A" and +1 would work.

Lastrow = Sheets(i).Cells(Rows.Count, "L").End(xlUp).Row + 1

Glad to see you have things working.
Last row always wants to know what column has the last row of data
Most times it "A" but not always