VBA copy based on column header

[DrH100]

I've no idea where to start with this so any help appreciated

What I would like to do is search through an active worksheet until I find a specific column header ("Origin") in row 1, copy the entire column contents (minus the row 1 header) and paste it to a specific cell (D50) on another worksheet ("Track").

The active worksheet pulls it's data from elsewhere and the base data keeps changing so the column for "Origin" keeps changing, hence the need to search for that column header

Hope that makes some sense and any thoughts greatly appreciated.

 

[Joe4]

Try this:

Sub MyMoveMacro()

    Dim fCell As Range
    Dim col As Long
    Dim lr As Long
    Dim rng As Range

'   Find cell in row 1 equal to "Origin"
    Set fCell = Rows("1:1").Find(What:="Origin", After:=Range("A1"), LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
        
'   Check to see if found
    If fCell Is Nothing Then
        MsgBox "Value of 'Origin' not found in row 1 on sheet " & ActiveSheet.Name, vbOKOnly, "ERROR!"
        Exit Sub
    End If

'   Find last row with data in "Origin" column
    col = fCell.Column
    lr = Cells(Rows.Count, col).End(xlUp).Row

'   Build range to copy
    Set rng = Range(Cells(2, col), Cells(lr, col))
    
'   Copy range to Track sheet
    rng.Copy Sheets("Track").Range("D50")
    
End Sub

 

[DrH100]

Try this:

Sub MyMoveMacro()

    Dim fCell As Range
    Dim col As Long
    Dim lr As Long
    Dim rng As Range

'   Find cell in row 1 equal to "Origin"
    Set fCell = Rows("1:1").Find(What:="Origin", After:=Range("A1"), LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False)
       
'   Check to see if found
    If fCell Is Nothing Then
        MsgBox "Value of 'Origin' not found in row 1 on sheet " & ActiveSheet.Name, vbOKOnly, "ERROR!"
        Exit Sub
    End If

'   Find last row with data in "Origin" column
    col = fCell.Column
    lr = Cells(Rows.Count, col).End(xlUp).Row

'   Build range to copy
    Set rng = Range(Cells(2, col), Cells(lr, col))
   
'   Copy range to Track sheet
    rng.Copy Sheets("Track").Range("D50")
   
End Sub

Thanks very much. I couldn't get it to paste into the other sheet but just changed the last Line or 2 and it works perfectly.

Would never have got anywhere near that.

Thanks

 

[Joe4]

You are welcome.