Find column header and copy contents of column to a second sheet within workbook

[Lilly44]

Hi,
I was wondering if someone could help me with a macro. I have a spreadsheet 'Sheet 1' that has column headers starting on row 8 and information corresponding to the columns for up to 50 rows. The column headers span columns A-Z. I need to find the following headers: "Well", "Sample Name", "Task", "Ct" and "Quantity" and move the header and contents of the rows underneath to the following static locations in 'Sheet 2': G9, A9, B9, H9 and C9 respectively.

The column headers and corresponding info in Sheet 1 are not always in the same columns which is why i'm saying they need to be 'found' and then moved over however, they always start on row 8.

Thanks in advance for any help!
Lilly

 

[JoeMo]

This assumes by "move the header and contents" you mean cut them. Also assumes that the tab names are Sheet1 and Sheet2 (not Sheet 1 and Sheet 2), and that Sheet2 already exists.

Sub Lilly44()
Dim Sht1 As Worksheet, Sht2 As Worksheet, FindRng As Range, Fnd As Range, Headers As Variant, Receivers As Variant, lR As Long
Set Sht1 = Sheets("Sheet1"): Set Sht2 = Sheets("Sheet2")
Headers = Array("Well", "Sample Name", "Task", "Ct", "Quantity")
Receivers = Array("G9", "A9", "B9", "H9", "C9")
Set FindRng = Intersect(Sht1.Rows(8), Sht1.Columns("A:Z"))
Application.ScreenUpdating = False
For i = LBound(Headers) To UBound(Headers)
    Set Fnd = FindRng.Find(Headers(i))
    If Not Fnd Is Nothing Then
        lR = Sht1.Cells(Sht1.Rows.Count, Fnd.Column).End(xlUp).Row
        Sht1.Range(Fnd, Sht1.Cells(lR, Fnd.Column)).Cut Destination:=Sht2.Range(Receivers(i))
    Else
        MsgBox "Can't find the header " & Headers(i) & " in Sheet1, row 8"
    End If
Next i
Application.ScreenUpdating = True
End Sub

 

[Lilly44]

Thanks for your prompt respose and help JoeMo!

The second assumption is correct but can it be tweaked so that instead of cutting it the columns are copied onto Sheet2?
Thanks again.
Lilly

 

[Lilly44]

Never mind..I just changed cut for copy and it works beautifully!! Thank you so much

 

[JoeMo]

Never mind..I just changed cut for copy and it works beautifully!! Thank you so much

You are welcome - thanks for the reply.

 

[Newbie06]

Hi Joe! Thanks for the above solution, I was able to tweak it to my own needs and works perfectly well almost in one case:
Let's say I have headers ["Employee ID", "Employee"] in that particular order and I want to copy-paste only the "Employee" column. When I use the above code, it for some reason copies "Employee ID" and not the "Employee" column.

Any suggestions?

 

[JoeMo]

Change this line:
Set Fnd = FindRng.Find(Headers(i))
to this:
Set Fnd = FindRng.Find(Headers(i),Lookat:= xlWhole)