I've got a workbook with 11 worksheets. Every workbook has Row 1 as column headers. Some of the column headers are common to all worksheets, but they are not consistently in the same order.
Sheet1 is source sheet. I want to transfer the data from sheet1 to all other sheets based on their column header. I tried to modified a code but its working only for 1 target sheet.
Sub AG()
Dim ws_B As Worksheet
Dim HeaderRow_A As Long
Dim HeaderLastColumn_A As Long
Dim TableColStart_A As Long
Dim NameList_A As Object
Dim SourceDataStart As Long
Dim SourceLastRow As Long
Dim Source As Variant
Dim rowTarget As Long
Dim iHighestUsedRow&
Dim LastRow As Long
Dim i As Long
Dim ws_B_lastCol As Long
Dim NextEntryline As Long
Dim SourceCol_A As Long
Set ws_A = Worksheets("Sheet1")
Set ws_B = Worksheets("Sheet2")
Set NameList_A = CreateObject("Scripting.Dictionary")
With ws_A
SourceDataStart = 2
HeaderRow_A = 1
TableColStart_A = 1
HeaderLastColumn_A = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
iHighestUsedRow = 0
For i = TableColStart_A To HeaderLastColumn_A
If Not NameList_A.Exists(UCase(.Cells(HeaderRow_A, i).Value)) Then
NameList_A.Add UCase(.Cells(HeaderRow_A, i).Value), i
End If
Next i
End With
With ws_B
ws_B_lastCol = .Cells(HeaderRow_A, Columns.Count).End(xlToLeft).Column
For i = 1 To ws_B_lastCol
SourceLastRow = .Cells(Rows.Count, i).End(xlUp).Row
If SourceLastRow > iHighestUsedRow Then
iHighestUsedRow = SourceLastRow
End If
Next i
End With
With ws_B
For i = 1 To ws_B_lastCol
SourceCol_A = NameList_A(UCase(.Cells(1, i).Value))
If SourceCol_A <> 0 Then
SourceLastRow = ws_A.Cells(Rows.Count, SourceCol_A).End(xlUp).Row
If SourceLastRow > 1 Then
Set Source = ws_A.Range(ws_A.Cells(SourceDataStart, SourceCol_A), ws_A.Cells(SourceLastRow, SourceCol_A))
NextEntryline = iHighestUsedRow + 1
.Range(.Cells(NextEntryline, i), _
.Cells(NextEntryline, i)) _
.Resize(Source.Rows.Count, Source.Columns.Count).Cells.Value = Source.Cells.Value
End If
End If
Next i
End With
End Sub