Question

我有一个excel工作簿，其中包含多个包含数据的工作表，但它们的列标题顺序不同。我还有一张名为＆＃34; Template＆＃34;包含列名称，我需要合并所有工作表并将它们带入模板。

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

匹配列标题和合并工作表

1 个答案: