匹配列標題和合並工作表

Question

我有一個Excel工作簿，其中包含數據的多個工作表，但其列標題的順序不同。我也有一個名爲「模板」的工作表，其中包含列名，我需要將所有工作表合併到模板中。

Ex- 
Sheet 1 = Name DOB Age 
      Sam 1/2 22 
      Pat 22/6 25 
Sheet 2 = DOB Age Name 
      5/6 21 Peter 
Sheet 3 = Name 
      Ben 
Sheet 4 = Age 
      27/9 

Template = Name Age DOB 
      Sam 22 1/2 
      Pat 25 22/6 
      Peter 21 5/6 
      Ben 0 0 
      0  0 27/9 

所以模板應串接一個接一個地從下工作表的所有數據，留下0無論列不存在於相應的表。

下面的代碼爲1個工作表正確地執行它，但是當我創建包含所有工作表的外觀時，它將寫入數據。

Sub CopyHeaders() 
    Dim header As Range, headers As Range 
    Dim ws2 As Worksheet 
    Dim Template As Worksheet 
    Dim cell As Range 
    For Each ws2 In ActiveWorkbook.Worksheets 
    If IsError(Application.Match(ws2.Name, _ 
    Array("Template", "Sheet1"), 0)) Then 
    Set Rng = ws2.UsedRange 
    For Each cell In Rng 
     If cell.Value = "" Then cell.Value = "0" 

    Next 
    Set headers = ws2.Range("A1:Z1") 
    For Each header In headers 
     If GetHeaderColumn(header.Value) > 0 Then 
     Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1, 0) 
     End If 
    Next 
    End If 
    Next 
End Sub 
Function GetHeaderColumn(header As String) As Integer 
    Dim headers As Range 
    Set headers = Worksheets("Template").Range("A1:Z1") 
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0) 
End Function 

我的錯誤是特別是在

Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=Worksheets("Template").Cells(2, GetHeaderColumn(header.Value)).End(xlDown).End(xlUp).Offset(1, 0) 

需要幫助，請！

Answer 1

您需要更改2在Cells(2, GetHeaderColumn(header.Value))在那一行的東西大，可能Worksheets("Template").Rows.Count（這意味着你還可以去除.End(xlDown)）。

.End(xlDown).End(xlUp)如果您已經在底部（如第一個副本的情況下）那麼您在此刻找到的是連續範圍的底部，但如果您在該範圍內的任何其他位置（如第一個副本）第2行將用於任何進一步的複製），因此您將開始覆蓋。