匹配列标题和合并工作表

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行将用于任何进一步的复制），因此您将开始覆盖。