Match Headers Between Two Sheets and Copy Column Data

Question

I have two sheets, Sheet1 & Sheet2, with same header names.

Header names are not in same order.
Sheet2 has more headers than Sheet1.
Headers of Sheet1 are located on C4:AG4.
Headers of Sheet2 are located on F6:EK6.

I would like to match header names between sheets, and copy data & formulas of each column from Sheet1 to appropriate columns of Sheet2.

Sub Oval4_Click()

Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") 'Sheet that has data
Dim LRow As Long, Found As Range

Set Found = ws.Range("C4:AG4").Find("*Invoice Number") 'Header name to search for

If Not Found Is Nothing Then
    LRow = ws.Cells(ws.Rows.Count, Found.Column).End(xlUp).Row
    ws.Range(ws.Cells(7, Found.Column), ws.Cells(LRow, Found.Column)).Copy

    'Sheet to paste data
    ActiveWorkbook.Sheets("Sheets2").Range("H7").PasteSpecial xlPasteFormulas

End If

End Sub

I am able to copy data to Sheet2 one by one.

As I have around 30 column headers on Sheet1, is there a way to add a loop to copy all data?

Unknown Unknown · Accepted Answer · 2020-11-09T01:49:32

This is really just a case of using Application.WorksheetFunction.Match() to get the destination column to paste the data to. Something like the following would do it:

Option Explicit
Dim SourceHeader As Range, DestHeader As Long, LastRow As Long, myCol As Long, myRow As Long
Sub CopyUsingHeaders()

For Each SourceHeader In Sheet1.Range("C4:AG4")
      
    myCol = SourceHeader.Column
    myRow = SourceHeader.Row
    
    With Sheet1
    LastRow = .Cells(.Rows.Count, myCol).End(xlUp).Row
    End With
    
    With Sheet2
    DestHeader = Application.WorksheetFunction.Match(SourceHeader, Sheet2.Range("A6:EK6"), 0)
    End With
    
    Sheet1.Range(Sheet1.Cells(myRow, myCol), Sheet1.Cells(LastRow, myCol)).Copy _
    Sheet2.Cells(7, DestHeader)

Next

End Sub

Match Headers Between Two Sheets and Copy Column Data

1 Answers