VBA Code to copy data from multiple worksheets and paste into single "Combined" worksheet

[nshepo20]

Hello, I need help with how my VBA code works. I am trying to copy data from multiple worksheets (variable number and names) into a single "Combined" worksheet. This is proving more difficult because there are hidden worksheets that I can't change and "Template" sheet only has one row of data so using "Range(Selection, Selection.End(xlDown)).Copy" for that worksheet wouldn't work... Thus I have my code doing the "Template" sheet first and then doing the loop, however my code only does it on the "Combined" sheet and ignore my <> "Combined".

Can someone explain why this doesn't work and potentially help me fix it. Thank you!!

PS

I think it has something to do with using select? But I am trying to learn how to avoid using it so any tips on that end would be really appreciated...

Sub CP2Combined()

Dim Current As Worksheet

        Sheets("Template").Range("C2:AH2").Copy
        Sheets("Combined").Range("B3").Select
        ActiveSheet.Paste
       
For Each Current In Worksheets
   
     If Current.Visible = xlSheetVisible Then
     If Current.Name <> "Combined" And _
        Current.Name <> "Template" Then
            Range("C2:AH2").Select
            Range(Selection, Selection.End(xlDown)).Copy
            Sheets("Combined").Select
            Range("B" & Rows.Count).End(xlUp).Offset(1).Select
            ActiveSheet.Paste
      End If
      End If
Next


End Sub

 

[Fluff]

Try

Sub CP2Combined()

Dim Current As Worksheet

        Sheets("Template").Range("C2:AH2").Copy
        Sheets("Combined").Range("B3").Select
        ActiveSheet.Paste
        
For Each Current In Worksheets
    
     If Current.Visible = xlSheetVisible Then
     If Current.Name <> "Combined" And _
        Current.Name <> "Template" Then
            With Current
               .Range("C2:AH" & .Range("C" & Rows.Count).End(xlUp).Row).Copy Sheets("Combined").Range("B" & Rows.Count).End(xlUp).Offset(1)
            End With
      End If
      End If
Next


End Sub

 

[nshepo20]

Try

Sub CP2Combined()

Dim Current As Worksheet

        Sheets("Template").Range("C2:AH2").Copy
        Sheets("Combined").Range("B3").Select
        ActiveSheet.Paste
       
For Each Current In Worksheets
   
     If Current.Visible = xlSheetVisible Then
     If Current.Name <> "Combined" And _
        Current.Name <> "Template" Then
            With Current
               .Range("C2:AH" & .Range("C" & Rows.Count).End(xlUp).Row).Copy Sheets("Combined").Range("B" & Rows.Count).End(xlUp).Offset(1)
            End With
      End If
      End If
Next


End Sub

Thank you so much it works! <3 I spent way too much time trying to figure that out lol

 

[JackDanIce]

Alternatively, slightly different code but similar end result (I hope!), try:

Sub Combine_Sheets()
  
    Dim ignore_sheets As Variant
    Dim x As Long
    Dim c As Long
  
    ignore_sheets = Valid_Sheet_Names
    c = Range("C2:AH2").Columns.Count
  
    Application.ScreenUpdating = False
  
    With Sheets("Combined")
        'Clear master sheet and add template
        x = .cells(.Rows.Count, 2).End(xlUp).Row
        With .[B3]
            .Resize(x, c).value = ""
            .Resize(, c).Value = Sheets("Template").Cells(2, 3).Resize(, c).Value
        End With
  
        'Combine sheets
        For x = 1 To Worksheets.Count
             With Sheets(x)
                If InStr(ignore_sheets, .name) = 0 Then Add_Data Sheets(x), c
            End With
        Next x
                  
        'Set focus to Combined
        If ActiveSheet.name <> .name Then .Activate
    End With
 
    Application.ScreenUpdating = True
  
    Erase ignore_sheets

End Sub

Private Function Valid_Sheet_Names() As String
  
    Valid_Sheet_Names = "Combined|Template"
  
End Function

Private Sub Add_Data(wks As Worksheet, c As Long)

    Dim x As Long
  
    With wks
        x = .Cells(.Rows.Count, 3).End(xlUp).Row - 1
        If x > 0 Then Sheets("Combined").Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(x, c).Value = .Cells(2, 3).Resize(x, c).Value
    End With
  
End Sub

 

[Fluff]

Thank you so much it works!

You're welcome & thanks for the feedback.