VBA code to copy data from one worksheet to many

[dlamle]

I need a code to complete this objective:

IF sheet count > 16 THEN copy data (range A1:L50) from a sheet named "Multiple" and paste into each worksheet until the last active worksheet has been populated.


Any help is greatly appreciated, thank you

 

[mumps]

To clarify ...... Do you want to copy the range only if you have more than 16 sheets in your workbook and if so, copy the range to all sheets?

 

[ismii]

Sub test()
Dim shtMultiple As Worksheet
Dim counter As Long 'Generic counter


    If ThisWorkbook.Sheets.Count > 16 Then
        'Do
        On Error Resume Next
        Set shtMultiple = ThisWorkbook.Sheets("Multiple")
        On Error GoTo 0
        
        If shtMultiple Is Nothing Then
            MsgBox "Error. Sheet DNE."
            Exit Sub
        End If
        
        counter = 1 'first sheet
        Do
            If ThisWorkbook.Sheets(counter).Name <> shtMultiple.Name Then
                ThisWorkbook.Sheets(counter).Range("A1:L50").Value = _
                    shtMultiple.Range("A1:L50").Value
            End If
            
            counter = counter + 1
        Loop While counter <= ThisWorkbook.Sheets.Count
        
    End If
    


End Sub

 

[Kuljack]

Try this.

    If Application.Sheets.Count > 16 Then
    Sheets("Sheet1").Select
        Range("A1:L50").Select
    Selection.Copy
    
    Do Until ActiveSheet.Next Is Nothing
        ActiveSheet.Next.Select
        ActiveSheet.Paste
    Loop
    
    End If

 

[dlamle]

Actually, its 15 (my bad), but yes! only copy the range if there is more than 15 sheets, and then paste it to any sheets after sheet #15 all the way until the last active worksheet.

 

[Kuljack]

Have you tried ISMII or my suggested codes, let me know if that works for you. Just change the value of 16 to 15

 

[dlamle]

Try this.

    If Application.Sheets.Count > 16 Then
    Sheets("Sheet1").Select
        Range("A1:L50").Select
    Selection.Copy
    
    Do Until ActiveSheet.Next Is Nothing
        ActiveSheet.Next.Select
        ActiveSheet.Paste
    Loop
    
    End If

Perfect! This code does the trick. thank you for your help.

 

[Kuljack]

Happy to help!

Regards.