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.