Excel 宏用于在两个 OPEN 工作簿之间复制匹配列标题的数据答案

【问题标题】：Excel macro to copy data matching column header between two OPEN WorkBooksExcel 宏用于在两个 OPEN 工作簿之间复制匹配列标题的数据
【发布时间】：2017-04-24 20:04:40
【问题描述】：

我正在寻找一个宏来在两个 OPEN 工作簿之间复制与列标题匹配的数据。我有以下代码可以在同一工作簿中的工作表之间复制数据。但我需要如下在两个打开的工作簿之间进行复制。

首先打开目标工作簿（其中有一个宏按钮可以复制数据）
第二个开源工作簿（实际查看和验证数据）
第三，进入目标工作簿，点击按钮进行复制。

谁能帮帮我。

Sub CopyMatchingHeaders()

Dim wbSource As Workbook
Dim SFileName As Variant

SFileName = Application.GetOpenFilename("Excel Files, *.xlsx, *.xls*,", MultiSelect:=False)

If TypeName(SFileName) = "String" Then
    Set wbSource = Workbooks.Open(SFileName)
Else
    MsgBox "No file selected."
    Exit Sub
End If


Dim header As Range, headers As Range
Set headers = ActiveWorkbook.Worksheets("Sheet1").Range("A1:AE1")

For Each header In headers
    If GetHeaderColumn(header.Value) > 0 Then
        Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=ActiveWorkbook.Worksheets("Sheet2").Cells(2, GetHeaderColumn(header.Value))
    End If
Next

End Sub

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

【问题讨论】：

你有没有尝试过任何你想做的事情？如果是这样，请更新问题以显示您尝试过的内容并告诉我们哪个部分没有按预期工作。
我试过上面更新的代码，效果很好。但是这段代码会一次性打开源文件并复制数据。我需要单独的宏按钮先打开文件，然后复制数据。我有打开源文件的代码，但从那里我需要代码来复制数据。谢谢

标签： excel vba

【解决方案1】：

您可以尝试修改这些语句：

Range(header.Offset(1, 0), header.End(xlDown)).Copy Destination:=ActiveWorkbook.Worksheets("Sheet2").Cells(2, GetHeaderColumn(header.Value))
'                                                                ^^^^^^^^^^^^^^

和

Set headers = ActiveWorkbook.Worksheets("Sheet2").Range("A1:AE1")
'             ^^^^^^^^^^^^^^

将ActiveWorkbook 替换为：

Workbooks("TheOtherWorkbookName")

目标工作表的名称也可能与 "Sheet2" 不同。

【讨论】：