VBA Help to find a column based on header value and cupy it to an other worksheet - excel

Question

I have this basic code to find the needed coumns in a table and copy them to an other worksheet. My problem is that every time I want to modify it to not to copy&paste the header it returns error. This is my code:
Sub CopyColumns()
Dim wsSource, wsResult As Worksheet
Dim Name, UniqueId, OperatingStatus As Long
Set wsSource = ThisWorkbook.Sheets("Source")
Set wsResult = ThisWorkbook.Sheets("Result")
Name = wsSource.Rows(1).Find("#BASEDATA#name").Column
UniqueId = wsSource.Rows(1).Find("#BASEDATA#uniqueId").Column
OperatingStatus = wsSource.Rows(1).Find("#BASEDATA#operatingStatus").Column
If Name <> 0 Then
wsSource.Columns(Name).Copy Destination:=wsResult.Columns(3)
End If
If UniqueId <> 0 Then
wsSource.Columns(UniqueId).Copy Destination:=wsResult.Columns(4)
End If
If OperatingStatus <> 0 Then
wsSource.Columns(OperatingStatus).Copy Destination:=wsResult.Columns(1)
End If
End Sub
Any ideas how to solve it?
I tried is to copy like this using offset:
If targetColName <> 0 Then
wsSource.Columns(targetColName).Offset(1, 0).Resize(wsSource.Rows.Count - 1).Copy _ Destination:=wsResult.Columns(3).Offset(1, 0)
It gives Error: Application-defined ot object-defined error
Thanks!
offset and resize not working

Answer 1

You can break out the "copy column if found" into a separate sub:
Sub CopyColumns()
Dim wsSource, wsResult As Worksheet
Set wsSource = ThisWorkbook.Sheets("Source")
Set wsResult = ThisWorkbook.Sheets("Result")
CopyIfExists wsSource.Rows(1), "#BASEDATA#name", wsResult, 3
CopyIfExists wsSource.Rows(1), "#BASEDATA#uniqueId", wsResult, 4
CopyIfExists wsSource.Rows(1), "#BASEDATA#operatingStatus", wsResult, 1
End Sub
'Look for `colName` in `headerRow`, and if found copy the whole
' column to column `destColNum` on `destSheet`
Sub CopyIfExists(headerRow As Range, colName As String, destSheet As Worksheet, destColNum As Long)
Dim f As Range
Set f = headerRow.Find(what:=colName, lookat:=xlWhole) 'or xlPart
If Not f Is Nothing Then
f.EntireColumn.Copy destSheet.Cells(1, destColNum)
End If
End Sub
When using find, you should check you got a match before trying to do anything with the matched cell.

Answer 2

Copy Columns
Option Explicit
Sub CopyColumnsToResult()
Dim sColNames(): sColNames = Array("#BASEDATA#name", _
"#BASEDATA#uniqueId", "#BASEDATA#operatingStatus")
Dim dCols(): dCols = Array(3, 4, 1)
Dim sws As Worksheet: Set sws = ThisWorkbook.Sheets("Source")
Dim shrg As Range: Set shrg = sws.Rows(1)
Dim slCell As Range: Set slCell = shrg.Cells(shrg.Cells.Count) ' last cell
Dim dws As Worksheet: Set dws = ThisWorkbook.Sheets("Result")
Dim shCell As Range, c As Long
For c = LBound(sColNames) To UBound(sColNames)
Set shCell = shrg.Find(sColNames(c), slCell, xlFormulas, xlWhole)
If Not shCell Is Nothing Then ' header cell found
sws.Columns(shCell.Column).Copy dws.Columns(dCols(c))
End If
Next c
MsgBox "Columns copied.", vbInformation
End Sub