Use this code
Option Explicit
Sub find_cols()
Dim lcol As Long, lrow As Long
Dim sfield As Variant
Dim cellcol As Range
Dim i As Long, fcol As Long
With Worksheets("Sheet1")
lcol = .Range("IV1").End(xlToLeft).Column
For i = 1 To lcol
sfield = .Cells(1, i).Value
Set cellcol = Worksheets("Sheet2").Rows(9).Find(Trim(sfield), , xlValues, xlWhole)
If Not cellcol Is Nothing Then
fcol = cellcol.Column
lrow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range(.Cells(3, i), .Cells(lrow, i)).Copy Worksheets("Sheet2").Cells(11, fcol)
Application.CutCopyMode = False
End If
Next i
End With
End Sub
Put it in a standard module.
Bookmarks