VBA- Macro for copy and paste of dynamic info into summary tab

Question

First question here and an issue that is melting my poor brain.

I have a Workbook and it has 6 tabs. These tabs are different divisions of a company. Each tab contains different headings like 'Employee Number' or 'First name' or 'Second name'. The heading aren't all in the same columns across the different tabs. (info being pulled from 6 different payrolls). The information is also changing on a monthly basis due to terminations and hires etc. The info is dynamic.

I want to consolidate these into one long list.

For example:

I want VBA to copy the info from column A in tab1 into Column A in tab7 (summary tab) and then copy the info from Column A in tab2 into the NEXT BLANK CELL in column A in tab7 and so on and so forth for the rest of the divisional tabs.

Finally Id like to be left with one unbroken list of all the info I need. I hope to be able to run a macro each month for this to save all the time wasting copying and pasting.

Would really appreciate some help. So far my efforts have ended in frustration.

Sub Test2()
'
' Test2 Macro
'Dim s1 As Excel.Worksheet
Dim s2 As Excel.Worksheet
Dim iLastCellS2 As Excel.Range
Dim iLastRowS1 As Long

Set s1 = Sheets("BaulderStone")
Set s2 = Sheets("Flattened Contribution File ")

'iLastRowS1 = s1.Cells(s1.Rows.Count, "A").End(xlUp).Row

'Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

's1.Range("A1", s1.Cells(iLastRowS1, "A")).Copy iLastCellS2

'Dim s3 As Excel.Worksheet
Dim s2 As Excel.Worksheet
Dim iLastCellS2 As Excel.Range
Dim iLastRowS1 As Long
Set s3 = Sheets("Retirement Living")
Set s2 = Sheets("Flattened Contribution File ")

' iLastRowS3 = s3.Cells(s1.Rows.Count, "D").End(xlUp).Row

' Set iLastCellS2 = s2.Cells(s2.Rows.Count, "A").End(xlUp).Offset(1, 0)

's3.Range("A1", s3.Cells(iLastRowS3, "A")).Copy iLastCellS2
'
End Sub

Answer 1

If you're only copying a single column from each sheet, and that column is in a fixed position on each different source sheet:

Sub Test3()

    Const CONSOLIDATED As String = "Flattened Contribution File"
    Dim wb As Workbook, sht As Worksheet, shtC As Worksheet
    Dim c As Long

    Set wb = ActiveWorkbook

    On Error Resume Next
    Set shtC = wb.Worksheets(CONSOLIDATED)
    On Error GoTo 0

    If shtC Is Nothing Then
        Set shtC = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        shtC.Name = CONSOLIDATED
    End If

    For Each sht In wb.Worksheets

        Select Case sht.Name
            Case "BaulderStone": c = 1       'get from ColA
            Case "Retirement Living": c = 4  'get from ColD
            'add your other sheets here....
            Case Else: c = 0
        End Select

        If c > 0 Then
            sht.Range(sht.Cells(2, c), sht.Cells(Rows.Count, c).End(xlUp)).Copy _
              shtC.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        End If

    Next sht

End Sub

EDIT: if source and destination columns are the same for each source sheet then something like this should work. Note: each source sheet must have headers in Row1

Sub Test4()

    Const CONSOLIDATED As String = "Flattened Contribution File"
    Dim wb As Workbook, sht As Worksheet, shtC As Worksheet
    Dim c As Long, numRows As Long
    Dim map, colSrc As String, colDest As String
    Dim destRow As Long

    Set wb = ActiveWorkbook

    On Error Resume Next
    Set shtC = wb.Worksheets(CONSOLIDATED)
    On Error GoTo 0

    If shtC Is Nothing Then
        Set shtC = wb.Sheets.Add(after:=wb.Sheets(wb.Sheets.Count))
        shtC.Name = CONSOLIDATED
    End If

    destRow = 2

    'create 2-d array of source & dest columns A-->A, C-->B, D-->C
    map = [{"A","A";"C","B";"D","C"}]

    For Each sht In wb.Worksheets
        'edit: add the sheet names you want to exclude from copying here
        '...or switch it around to check for names you *want* to consolidate...
        If sht.Name <> CONSOLIDATED And sht.Name <> "Report" _
           And sht.Name <> "whatever" Then

            '# of data rows....
            numRows = sht.UsedRange.Rows.Count - 1

            For c = LBound(map, 1) To UBound(map, 1)

                colSrc = map(c, 1)
                colDest = map(c, 2)

                With sht
                    .Range(.Range(colSrc & "2"), .Range(colSrc & (numRows + 1))).Copy _
                          shtC.Range(colDest & destRow)
                End With
            Next c

            destRow = destRow + numRows

        End If
   Next sht

End Sub