Excel/VBA - Combine rows and columns from worksheets into one, with varying source columns

Question

I am working on combining multiple Excel worksheets into a single Master worksheet. The following code works for when all worksheets have identical columns:

Sub CombineData()
Dim Sht As Worksheet

'This If will clear Master before combining
Worksheets("Master").Range("A2:ZZ9000").ClearContents

For Each Sht In ActiveWorkbook.Worksheets
    If Sht.Name <> "Master" And Sht.Range("A2").Value <> "" Then
        Sht.Select
        LastRow = Range("A9000").End(xlUp).Row
        Range("A2", Cells(LastRow, "ZZ")).Copy
        Sheets("Master").Select
        Range("A9000").End(xlUp).Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Else
    End If
Next Sht

End Sub

However, I now need to go one step further and merge worksheets when the columns differ from the source worksheets, into a master which has all coluns listed.

This shows the layout of the worksheets I'm testing with, to keep things simple.

I'm open to either mapping all source to destination columns (e.g.

-Source1, Column A to Master, Column A

-Source2, Column B to Master, Column D

-Etc

Or simply recreating Master with all columns from source worksheets - which is preferable in case source worksheets change.

Cheers-

What have you tried? Also, to note, it's best to avoid the use of .Select/.Activate — BruceWayne

Valli Valli · Accepted Answer · 2017-10-11T22:59:34

I have made some changes to your code, to make it suitable for mapping any column from master to sheet1. You have to hard code the mapping inside the code Sub CombineData() Dim Sht As Worksheet Dim colname As String Dim Lastrow As Integer, rowcount As Integer 'This If will clear Master before combining Worksheets("Master").Range("A2:ZZ9000").ClearContents colname = 1 For Each Sht In ActiveWorkbook.Worksheets

  If Sht.Name = "Sheet2" And Sht.Range("A2").Value <> "" Then
     Lastrow = Range("A9000").End(xlUp).Row
     Sheets("Master").Select
     rowcount = Range("A9000").End(xlUp).Row
     Sht.Select
'Map the columns of sheet2 to master
     Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
     Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value

  ElseIf Sht.Name = "Sheet3" And Sht.Range("A2").Value <> "" Then
     Lastrow = Range("A9000").End(xlUp).Row
     Sheets("Master").Select
     rowcount = Range("A9000").End(xlUp).Row
     Sht.Select
'Map the columns of sheet3 to master
     Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
     Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value
  End If
 Next Sht

End Sub

**************Edited********************

Sub CombineData()
Dim Sht As Worksheet
Dim colname As String
 Dim Lastrow As Integer, rowcount As Integer
'This If will clear Master before combining
Worksheets("Master").Range("A2:ZZ9000").ClearContents
 colname = 1
For Each Sht In ActiveWorkbook.Worksheets
  If Sht.Name = "Sheet1" And Sht.Range("A2").Value <> "" Then
Sheets("Sheet1").Select

Lastrow = Range("A9000").End(xlUp).Row

     Sheets("Master").Select
     rowcount = Range("A9000").End(xlUp).Row + 1
     Sht.Select
'Map the columns of sheet2 to master
     Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
     Sheets("Master").Range("B" & rowcount & ":B" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value
     Sheets("Master").Range("C" & rowcount & ":C" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value
     Sheets("Master").Range("D" & rowcount & ":D" & rowcount + Lastrow - 2).Value = Sht.Range("D2:D" & Lastrow).Value

  ElseIf Sht.Name = "Sheet2" And Sht.Range("A2").Value <> "" Then
Sheets("Sheet2").Select

     Lastrow = Range("A9000").End(xlUp).Row
     Sheets("Master").Select
     rowcount = Range("A9000").End(xlUp).Row + 1
     Sht.Select
'Map the columns of sheet3 to master
     Sheets("Master").Range("A" & rowcount & ":A" & rowcount + Lastrow - 2).Value = Sht.Range("A2:A" & Lastrow).Value
     Sheets("Master").Range("E" & rowcount & ":E" & rowcount + Lastrow - 2).Value = Sht.Range("B2:B" & Lastrow).Value
     Sheets("Master").Range("F" & rowcount & ":F" & rowcount + Lastrow - 2).Value = Sht.Range("C2:C" & Lastrow).Value
     Sheets("Master").Range("G" & rowcount & ":G" & rowcount + Lastrow - 2).Value = Sht.Range("D2:D" & Lastrow).Value
     Sheets("Master").Range("C" & rowcount & ":C" & rowcount + Lastrow - 2).Value = Sht.Range("E2:E" & Lastrow).Value

 End If
 Next Sht

End Sub

Excel/VBA - Combine rows and columns from worksheets into one, with varying source columns

1 Answers