Excel宏複製兩個OPEN工作簿之間匹配列標題的數據

我正在尋找一個宏來複制兩個OPEN工作簿之間匹配列標題的數據。我有以下代碼在同一工作簿中的工作表之間複製數據。但是我需要在兩個OPEN工作簿之間進行復制。Excel宏複製兩個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

來源

2017-04-24 Siraj

您是否嘗試過做任何您想做的事情？如果是這樣，請更新問題以顯示您嘗試過的內容，並告訴我們哪個位未按預期工作。 – YowE3K

我試過上面更新的代碼，它工作正常。但是這段代碼一次打開源文件並複製數據。我需要單獨的宏按鈕先打開文件，然後複製數據。我有代碼來打開源文件，但從那裏我需要代碼來複制數據。謝謝 – Siraj

您可以嘗試修改這些聲明：

：

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"不同。

來源

2017-04-24 11:58:37

Excel宏複製兩個OPEN工作簿之間匹配列標題的數據

回答

相關問題