'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 |
