Copy columns by its header value - vba

Question

I would like to copy column from excel "Book1" to another excel "Book2" by determined its cell value.
Let's say the header columns in Book1 are Name, Age, Gender, Address and Group. I want to copy the column "Name", "Age" and "Group" to "Book2". Below coding is what I've done to pull column data by cell coordinate.
Is it possible if I can pull the column from its header value?
Sub copyColumns()
Dim lr As Long, r As Long
Set src = ThisWorkbook.Worksheets("Sheet1")
Set tgt = Workbooks("Book2.xlsx").Worksheets("Sheet1")
lr = src.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lr
src.Cells(i, 1).copy
r = tgt.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
src.Paste Destination:=tgt.Cells(r, 1)
src.Cells(i, 2).copy
src.Paste Destination:=tgt.Cells(r, 2)
src.Cells(i, 5).copy
src.Paste Destination:=tgt.Cells(r, 3)
Next i
End Sub

Answer 1

There is number of solutions to this problem. For example, declare variables:
Dim rw As Range
Dim cl As Range
Dim sFields As String
Dim V
Dim j As Integer
Chose your column names for copying:
sFields = "Name|Age|Group"
V = Split(sFields, "|")
And then, inside your For i loop, make two another loops:
For Each cl In Intersect(src.Rows(i), src.UsedRange)
For j = 0 To UBound(V)
If cl.EntireColumn.Range("A1") = V(j) Then
tgt.Cells(i, j).Value = src.Cells(i, j).Value
End If
Next j
Next cl
Intersect(src.Rows(i), src.UsedRange) will chose all cells in row in the range that is actually used (that is, it will not loop through all 16 384 columns. All columns names are in one variable sFields, you can easily modify it. It is string separated with pipes, you will probably never use pipes (|) in your field names, so it is safe.

Answer 2

A few tips along the way:
Always declare every variable you want to use and user Option Explicit at the beginning of your module.
Dont copy every single cell, copy a range
See the updated code below:
Sub copyColumns2()
Dim src As Worksheet, tgt As Worksheet
Dim lr As Long, r As Long, I As Long, Col As Long
Dim ColsToCopy, ColToCopy, counter As Integer
ColsToCopy = Array("Name", "Age", "Group")
Set src = ThisWorkbook.Worksheets("Sheet1")
Set tgt = Workbooks("Book2.xlsx").Worksheets("Sheet1")
lr = src.Cells(Rows.Count, 1).End(xlUp).Row
For Col = 1 To 20
For Each ColToCopy In ColsToCopy
If src.Cells(2, Col).Value = ColToCopy Then
counter = counter + 1
src.Range(src.Cells(2, Col), src.Cells(lr, Col)).Copy tgt.Cells(2, counter)
Exit For
End If
Next ColToCopy
Next Col
End Sub

Answer 3

If you would like to copy the column by column header, you can use this function to get the letter of your header:
Function Letter(oSheet As Worksheet, name As String, Optional num As Integer)
If num = 0 Then num = 1
Letter = Application.Match(name, oSheet.Rows(num), 0)
Letter = Split(Cells(, Letter).Address, "$")(1)
End Function
Implementation:
Sub copycolum()
Dim ws As Worksheet, ws2 As Worksheet
Set ws = Sheets("Sheet1"): Set ws2 = Sheets("Sheet2"):
ws.Range(Letter(ws, "Gender") & "2:" & Letter(ws, "Gender") & ws.Range(Letter(ws, "Gender") & "1000000").End(xlUp).Row).Copy Destination:=ws2.Range(Letter(ws2, "Gender") & "2")
End Sub
Note that the function is set to default at row 1, in other words your header is in column 1, if you like you can change this to whatever row your data is in.