匹配两个工作表之间的标题并复制列数据答案

【问题标题】：Match Headers Between Two Sheets and Copy Column Data匹配两个工作表之间的标题并复制列数据
【发布时间】：2021-03-01 16:14:16
【问题描述】：

我有两张表，Sheet1 和 Sheet2，标题名称相同。

标题名称的顺序不同。
Sheet2 的标题比 Sheet1 多。
Sheet1 的标题位于 C4:AG4 上。
Sheet2 的标题位于 F6:EK6 上。

我想在工作表之间匹配标题名称，并将每列的数据和公式从 Sheet1 复制到 Sheet2 的相应列。

Sub Oval4_Click()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Sheet that has data
Dim LRow As Long, Found As Range

Set Found = ws.Range("C4:AG4").Find("*Invoice Number") 'Header name to search for

If Not Found Is Nothing Then
    LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
    ws.Range(ws.Cells(7, Found.Column), ws.Cells(LRow, Found.Column)).Copy

    'Sheet to paste data
    ActiveWorkbook.Sheets("Sheets2").Range("H7").PasteSpecial xlPasteFormulas

End If

End Sub

我可以将数据一一复制到 Sheet2。

由于 Sheet1 上有大约 30 个列标题，有没有办法添加一个循环来复制所有数据？

【问题讨论】：

标签： excel vba

【解决方案1】：

这实际上只是使用Application.WorksheetFunction.Match() 获取目标列以将数据粘贴到的情况。如下所示：

Option Explicit
Dim SourceHeader As Range, DestHeader As Long, LastRow As Long, myCol As Long, myRow As Long
Sub CopyUsingHeaders()

For Each SourceHeader In Sheet1.Range("C4:AG4")
      
    myCol = SourceHeader.Column
    myRow = SourceHeader.Row
    
    With Sheet1
    LastRow = .Cells(.Rows.Count, myCol).End(xlUp).Row
    End With
    
    With Sheet2
    DestHeader = Application.WorksheetFunction.Match(SourceHeader, Sheet2.Range("A6:EK6"), 0)
    End With
    
    Sheet1.Range(Sheet1.Cells(myRow, myCol), Sheet1.Cells(LastRow, myCol)).Copy _
    Sheet2.Cells(7, DestHeader)

Next

End Sub

【讨论】：