简体   繁体   中英

How to import another workbook into excel with VBA based on header?

I want to importing workbook into my current Excel sheet, now when I imported it is imparting by row order, for example:

Workbook 1:

Header:

Age , Name, Gender, BOD, Country

Workbook 2:

Header:

Name, Gender, Age

in Workbook 1 order of header always in not same

How can I import based on header?

Workbooks(MasterWB).Worksheets(MasterSheet).Range("A" & rowMaster).Value = Workbooks(TempWB).Worksheets(TempSheet).Range("A" & row).Value
    Workbooks(MasterWB).Worksheets(MasterSheet).Range("B" & rowMaster).Value = Workbooks(TempWB).Worksheets(TempSheet).Range("B" & row).Value
    Workbooks(MasterWB).Worksheets(MasterSheet).Range("C" & rowMaster).Value =

This should work for you:

Option Explicit
Sub CopyWorksheet()

    'https://stackoverflow.com/a/57818629/7558682
    'You'll need to check Microsoft Scripting Runtime reference under tools-->references for this to work.
    'Edit workbook and worksheet names to suit your needs.
    'For this to work you need that both headers are called exactly the same.

    Dim arr As Variant, arrTemp As Variant
    Dim i As Long, j As Long
    Dim MasterHeaders As New Scripting.Dictionary

    'this will throw the whole worksheet inside an array
    arrTemp = Workbooks("TempWorkbook.xlsx").Worksheets("TempSheet").UsedRange.Value
    'This will work if the master workbook is the same holding the code
    'change ThisWorkbook for Workbooks("MasterSheet") if not the case.
    With ThisWorkbook.Sheets("MasterSheet")
        ReDim arr(1 To UBound(arrTemp), 1 To .UsedRange.Columns.Count) 'redim the main array

        For i = 1 To UBound(arr, 2)
            'fill the headers for the final array
            arr(1, i) = .Cells(1, i)
            'fill a dictionary with the header locaton for the final array
            If Not MasterHeaders.Exists(arr(1, i)) And Not arr(1, i) = vbNullString Then _
                MasterHeaders.Add UCase(arr(1, i)), i
        Next i

        'Now fill the final array
        For i = 2 To UBound(arrTemp)
            For j = 1 To UBound(arrTemp, 2)
                If MasterHeaders.Exists(UCase(arrTemp(1, j))) Then arr(i, j) = arrTemp(i, j)
            Next j
        Next i
        'paste the final array back to the master sheet
        .Range("A1", .Cells(UBound(arr), UBound(arr, 2))).Value = arr
    End With

End Sub

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM