Moving data between sheets based on headers

[sa31]

Trying to just move data to another worksheet for columns with specified column names


With ThisWorkbook.Worksheets("Sheet1")

Dim ar As Variant
Dim i As Integer
Dim j As Long

ar = Array("Header1", "Header2") 'define header names to move

For i = 0 To UBound(ar)
j = [A1:AW1].Find(ar(i)).Column
Columns(j).Copy Sheet2.Cells(1, i + 1) 'copy to sheet2 from sheet1
Next I

End With

End Sub

But I still keep running into issues and can't debug

[jolivanes]

Sub One_Way_Maybe()
Dim headerArr, sh1 As Worksheet, sh2 As Worksheet, cCol As Long, i As Long
headerArr = Array("Header1", "Header2", "Header3")
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
For i = LBound(headerArr) To UBound(headerArr)
With sh1
cCol = .Rows(1).Find(headerArr(i)).Column
.Range(.Cells(1, cCol), .Cells(.Cells(.Rows.Count, cCol).End(xlUp).Row, cCol)).Copy sh2.Cells(1, sh2.Range("IV1").End(xlToLeft).Offset(, 1).Column)
End With
Next i
End Sub

[jolivanes]

Have not heard back if the code was to your liking.
Maybe it isn't. Here is another possibility.



Sub Another_Way_Maybe()
Application.Union(Cells(1, Rows(1).Find("Header1").Column), _
Cells(1, Rows(1).Find("Header2").Column)).EntireColumn.Copy _
Sheets("Sheet2").Range("A1")
End Sub