'VBA, Copy values from one sheet to another using header names

I want to copy values from sheet A to Sheet B but have it loop through the headers in both sheets, find the headers in sheet B and paste values from Sheet A into B based on headers. The reason behind this is that headers are not in the same column name so a straight copy and paste won't work.

I have the piece that copies and pastes it normally. But how can I get it to loop through the existing headers in Sheet B , headers will be predefined in row 1. Stuck at the copy and paste part.

    Sub stack()

Dim i As Integer
Dim y As Integer
Dim src As Range
Dim tgt As Range
Dim Headloop As String
Dim Headloop2 As String

Set src = Sheets("sheet1")  'source sheet
Set tgt = Sheets("sheet2")   'destination sheet

With tgt
For i = 1 To max_col
    Headloop = Range(i & "1").value 'i is column Number, "1" is row 1
Next i
End With

With src
For y = 1 To max_col
    Headloop2 = Range(y & "1").value 'y is column Number, "1" is row 1
Next y
End With

 For Each i In tgt
    If Headloop > 0 Then
    Range(y&"2"),src.Copy Destination: = tgt.range(i&"2").value
    End If
Next i


End Sub

thanks.



Solution 1:[1]

Untested, but the idea here is to iterate the cells in the destination sheet's Header row (For h = 1 to destination.Cells.Count), then use the Index function to obtain the corresponding column number on the source data sheet (or an error, if that column doesn't exist). Then it's simply copy/paste.

Dim s1 as Worksheet, s2 as Worksheet
Dim dataToCopy as Range, sourceData as Range, destination as Range
Dim h as Long, headerName as String
Dim columnNumber as Variant

Set s1 = Worksheets("Sheet1")           'modify as needed
Set s2 = Worksheets("Sheet2")           'modify as needed
Set destination = s2.Range("A1:A" & max_col) 
Set sourceData = s2.Range("A1:Z100")    'modify as needed

For h = 1 to destination.Cells.Count
    headerName = destination.Cells(1,h).Value
    columnNumber = Application.Index(headerName, sourceData.Rows(1), False)
    If IsError(columnNumber) Then
        ' this header wasn't found
        MsgBox headerName & " is not found on the source sheet!", vbCritical
    Else
        Set dataToCopy = sourceData.Columns(columnNumber)
        ' skip the header row
        Set dataToCopy = dataToCopy.Resize(sourceData.Rows.Count - 1).Offset(1)
        dataToCopy.Copy destination.Cells(1,h).Offset(1)
    End If
Next

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 David Zemens