根據包含空單元格的列標題將數據從一個工作表復制到另一個工作表

Question

我對宏很天真。 我使用下面的代碼將基於列標題的數據從同一工作簿中的sheet1復制到sheet2。 但是，當一個單元格為空時，它將停止復制。 列中的某些單元格為空。 因此，我需要宏來按原樣復制包括空單元格在內的整個列數據。

另外，我需要使用同一種宏在兩個不同的工作簿之間進行復制。 我感謝有人可以為此提供宏。

Sub CopyHeaders()
    Dim header As Range, headers As Range
    Set headers = Worksheets("ws1").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("ws2").Cells(2, GetHeaderColumn(header.Value))
        End If
    Next
End Sub

Function GetHeaderColumn(header As String) As Integer
    Dim headers As Range
    Set headers = Worksheets("ws2").Range("A1:Z1")
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function

謝謝

Answer 1

更新：將列復制到具有匹配列標題的另一個工作簿。

Sub CopyHeaders()

    Dim ws2 As Worksheet
    Dim header As Range, headers As Range
    Set headers = Worksheets("ws1").Range("A1:Z1")
    Dim headerColumn As Long

    Set ws2 = Workbooks("Some Other Workbook").Worksheets("ws2")

    For Each header In headers
        headerColumn = GetHeaderColumn(ws2, header.Value)
        If headerColumn > 0 Then
            header.Offset(1, 0).EntireColumn.Copy Destination:=ws2.Cells(1, headerColumn)
        End If
    Next
End Sub

Function GetHeaderColumn(ws2 As Worksheet, header As String) As Integer
    Dim headers As Range
    Set headers = ws2.Range("A1:Z1")
    GetHeaderColumn = IIf(IsNumeric(Application.Match(header, headers, 0)), Application.Match(header, headers, 0), 0)
End Function