基于标题名称将列从 Excel 复制到另一个工作表的 VBA 代码

Question

我正在尝试使用 VBA 创建一个 Excel 宏，以将基于列标题的整列复制到 Excel 工作表中。 到目前为止，当列标题位于工作表的第一行时，我的代码可以工作，但是如果我更改HeaderRow_A = 5和SourceDataStart = 6对于列标题位于第五行而不是第一行的工作表列按预期复制，但其他列没有。 我需要一些代码修订，以允许将所有所需的列从工作表 A 复制到工作表 B。这是我遇到问题的特定区域：

With ws_A
SourceDataStart = 6
HeaderRow_A = 5  'set the header row in sheet A
TableColStart_A = 1 'Set start col in sheet A
HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column  'Get number of NAMEs you have

以下是完整代码供您参考：

Sub RetrieveData()

Dim wb As Workbook
Dim ws_A As Worksheet
Dim ws_B As Worksheet

Dim HeaderRow_A As Long
Dim HeaderLastColumn_A As Long
Dim TableColStart_A As Long
Dim NameList_A As Object
Dim SourceDataStart As Long
Dim SourceLastRow As Long
Dim Source As Variant

Dim i As Long

Dim ws_B_lastCol As Long
Dim NextEntryline As Long
Dim SourceCol_A As Long

Set wb = ActiveWorkbook
Set ws_A = wb.Worksheets("Sheet A")
Set ws_B = wb.Worksheets("Sheet B")
Set NameList_A = CreateObject("Scripting.Dictionary")

With ws_A
    SourceDataStart = 6
    HeaderRow_A = 5  'set the header row in sheet A
    TableColStart_A = 1 'Set start col in sheet A
    HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column  'Get number of NAMEs you have

    For i = TableColStart_A To HeaderLastColumn_A
        If Not NameList_A.Exists(UCase(.Cells(HeaderRow_A, i).Value)) Then  'check if the name exists in the dictionary
             NameList_A.Add UCase(.Cells(HeaderRow_A, i).Value), i 'if does not exist record name as KEY and Column number as value in dictionary
        End If
    Next i

End With



With ws_B  'worksheet you want to paste data into
    ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column ' Get number of DATA you have in sheet B
    For i = 1 To ws_B_lastCol   'for each data
        SourceCol_A = NameList_A(UCase(.Cells(1, i).Value))  'get the column where the name is in Sheet A from the dictionaary

        If SourceCol_A <> 0 Then  'if 0 means the name doesnt exists
            SourceLastRow = ws_A.Cells(Rows.Count, SourceCol_A).End(xlUp).Row
            Set Source = ws_A.Range(ws_A.Cells(SourceDataStart, SourceCol_A), ws_A.Cells(SourceLastRow, SourceCol_A))
            NextEntryline = .Cells(Rows.Count, i).End(xlUp).Row + 1 'get the next entry line of the particular name in sheet A

            .Range(.Cells(NextEntryline, i), _
                   .Cells(NextEntryline, i)) _
                   .Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
        End If

    Next i
End With


End Sub

Answer 1

我看到标题在工作表 B 上的位置的两个相互冲突的定义。

此代码段表示您的工作表 B 标题与工作表 A 位于同一行

ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column

这个片段说他们在第 1 行

SourceCol_A = NameList_A(UCase(.Cells(1, i).Value))

我想这就是问题所在。