Search through column headers to find the right Column to copy and paste

[HeyHey89]

I am trying to look for a column name then select the data below to copy to another sheet HELP!

Sub Trial()

Dim rngFound As Range

ActiveCell.AutoFilterMode = True

Set rngFound = Rows(1).Find("List", Cells(1, Columns.Count), xlValues, xlWhole)

If Not rngFound Is Nothing Then

Columns(rngFound.Column).Copy Destination:=Worksheets("Sheet2").Cells("A2")

Application.CutCopyMode = False

End If

EsleIf rngFound Is Nothing Then

End If

End Sub

 

[My Aswer Is This]

Try this:

Sub Copy_Column()
'Modified 6/23/2018 12:15 AM  EDT
Application.ScreenUpdating = False
Dim i As Long
Dim LastrowColumn As Long
LastColumn = Cells(1, Columns.Count).End(xlToLeft).Column
    For i = 1 To LastColumn
        If Cells(1, i).Value = "List" Then
            Columns(i).Copy Sheets(2).Cells(1, 1): Exit Sub
        End If
    Next
Application.ScreenUpdating = True
End Sub

 

[jolivanes]

And another possibility. No Looping.

Sub AAAAA()
Dim colCopy As Long, lr As Long
    If Application.WorksheetFunction.CountIf(Sheets("Sheet1").Rows(1), "List") > 0 Then
        colCopy = Rows(1).Find("List", , , 1).Column
            lr = Cells(Rows.Count, colCopy).End(xlUp).Row
        Range(Cells(2, colCopy), Cells(lr, colCopy)).Copy Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Else
        MsgBox "No such value in the first row."
    End If
End Sub

BTW HeyHey, please use code tags around your code.

 

[Fluff]

Another option

Sub Trial()
   Dim rngFound As Range
   
   Set rngFound = Rows(1).Find("List", , xlValues, xlWhole, , , False, , False)
   If Not rngFound Is Nothing Then
      Columns(rngFound.Column).Copy Worksheets("Sheet2").Cells("A1")
   End If
End Sub