Excel / VBA-將工作表中的行和列合並為一個，具有不同的源列

Question

我正在將多個Excel工作表合並到一個主工作表中。 當所有工作表具有相同的列時，以下代碼適用：

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

但是，我現在需要更進一步，將列與源工作表不同時將工作表合並到包含所有列的主表中。

為了簡單起見，這顯示了我正在測試的工作表的布局。

我願意將所有源映射到目標列（例如

-Source1，列A為主，列A

-Source2，從B列到主數據，D列

-等等

或者只是簡單地使用源工作表中的所有列重新創建“母版”-如果源工作表發生更改，則更可取。

干杯-

Answer 1

我對您的代碼進行了一些更改，以使其適合於將任何列從master映射到sheet1。 您必須對代碼中的映射進行硬編碼Sub CombineData（）Dim Sht As Worksheet Dim colname As String Dim Lastrow As Integer，rowcount As Integer'如果在組合Worksheets（“ Master”）。Range（“ A2： ZZ9000“）。ClearContents colname = 1對於ActiveWorkbook.Worksheets中的每個Sht

  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

**************編輯********************

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