VBA - 基于标题复制粘贴值

如何解决VBA - 基于标题复制粘贴值

您好朋友和社区，我正在尝试根据标题将值从一张纸复制并粘贴到另一张纸上。

例如我有Sheet1和下面的表格

20200101	20200102	20200103
123	234	234
333	233	232

和Sheet2，表格如下

20200102	20200101	20200103

我希望我的 vba 代码使用标题作为参考将值从工作表 1 复制并粘贴到工作表 2。

幸运的是，我能够在下面找到执行我想要的精确操作的代码。但唯一的问题是原始源（Sheet1）的标题没有按照所需的语法从 A1（第 1 行第 1 列）开始。此外，粘贴目标标头也不从 A1 开始。我试图在下面的代码中更改几个参数，但始终无法使其工作。如果有人能帮助我理解以下语法并指导我需要更改哪个参数才能正确粘贴，将不胜感激。谢谢！

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("WIP-RSWW1")
Set ws_B = wb.Worksheets("Base Data_RS")
Set NameList_A = CreateObject("Scripting.Dictionary")

With ws_A
    SourceDataStart = 2
    HeaderRow_A = 2  'set the header row in sheet A
    TableColStart_A = 2 '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