Finding Data under a header and Copying to another sheet (VBA)

[RMKBrit]

Hello everyone!
I have been using Mr.Excel for a while and have always been able to find answers to my questions until now.
Basically I have a sheet which could have upto 52 columns of data, that are not always in the same sequence. I need to be able to find specific column names and copy the data below into another sheet.

Below is the code I have so far, basically this works but I can only copy the cell directly below the header title. How would I define the range from 1 cell below my header to the value of Lastrow1?

Thank you in advance for any help as this one is kicking my butt!!!

Sub CopyPaste2()
'attempt using a fixed range for the column search
Dim LastColumn As Long 'not currently using, but would like a dynamic range
Dim lastrow1 As Long
Dim SEHeaderCell As Range
Dim SEHeader As Range
Application.ScreenUpdating = False
Sheet3.Activate
'find last row
lastrow1 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
'using fixed range
Set SEHeader = Range("A1:AB1")
For Each SEHeaderCell In SEHeader
If SEHeaderCell.Value = "Location" Then
'Need to select and copy all cells down to "lastrow1" at this point
SEHeaderCell.Offset(1, 0).Select
Selection.Copy
Sheet2.Activate
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next SEHeaderCell
End Sub

 

[JLGWhiz]

See if this one does it for you

Sub copyColumn()
Dim sh As Worksheet, fn As Range
Set sh = Sheets("Sheet3")
Set fn = sh.Rows(1).Find("Location", , xlValues, xlWhole)
    If Not fn Is Nothing Then
        fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Sheet2").Range("M2")
    Else
        MsgBox "Search Item Not Found!"
        Exit Sub
    End If
End Sub

Since you were only posting to one column, I assumed you only had one column with 'Location' as a header. If you have more than one we can modify the code but need clarification on where to paste results.

 

[lrobbo314]

@JLGWhiz

I was kind of operating under the assumption that he would be copying to column M on Sheet2 multiple times. But, looking at his OP, you're solution is probably all he needs. But, since I wrote something up, and in case it's at all helpful, here's what I came up with.

Sub CP2()
Dim ws1             As Worksheet
Dim ws2             As Worksheet
Dim SEHeader        As Range
Dim SEHeaderCell    As Range
Dim ws1LR           As Long
Dim ws2LR           As Long

Set ws1 = Sheets("Sheet3")
Set ws2 = Sheets("Sheet2")
Set SEHeader = ws1.Range("A1:AB1")
ws1LR = ws1.Range("A" & Rows.Count).End(xlUp).Row()

    For Each SEHeaderCell In SEHeader
        If SEHeaderCell.Value = "Location" Then
            ws2LR = ws2.Range("M" & Rows.Count).End(xlUp).Row()
            ws2.Range("M" & ws2LR & ":M" & ws2LR + ws1LR).Value = ws1.Range(SEHeaderCell.Address, Cells(ws1LR, SEHeaderCell.Column()))
        End If
    Next SEHeaderCell
            
End Sub

 

[RMKBrit]

Thanks for the help guys, to clarify, I will be pasting to a different column in sheet 2 for each header title that I need. For example, "location" would go to m2 in sheet2, and let's say "address" would go to N2. The goal was to loop thru all the headers I need to look for and paste them to the correct destination in sheet 2

 

[JLGWhiz]

Then I suggest that you list the headers you want to find on a separate sheet (I will use sheet1 in the code but you can change that) and loop through that list to search for your columns. Here is code that would do that if your list of headers was in column A of sheet 1.

Sub copyColumn()
Dim sh As Worksheet, fn As Range, c As Range
Set sh = Sheets("Sheet3")
    For Each c In Sheets("Sheet1").Range("A2", Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp)) 'Change to actual sheet for list of headers.
        Set fn = sh.Rows(1).Find(c.Value, , xlValues, xlWhole)
                If Not fn Is Nothing Then
                If Sheets("Sheet2").Range("M2") = "" Then
                        fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy Sheets("Sheet2").Range("M2")
                Else
                    fn.Offset(1).Resize(sh.Cells(Rows.Count, fn.Column).End(xlUp).Row, 1).Copy _
                    Sheets("Sheet2").Cells(2, Columns.Count).End(xlToLeft).Offset(, 1)
                End If
                Else
                    MsgBox "Search Item Not Found!"
                    Exit Sub
                End If
    Next
End Sub

 

[RMKBrit]

Thanks so much for the help, this is what I needed. Both answers have are useful for what I am working on.

 

[JLGWhiz]

Thanks so much for the help, this is what I needed. Both answers have are useful for what I am working on.

You're welcome,
regards, JLG

 

[khatikvasim13]

Hello everyone!
I have been using Mr.Excel for a while and have always been able to find answers to my questions until now.
Basically I have a sheet which could have upto 52 columns of data, that are not always in the same sequence. I need to be able to find specific column names and copy the data below into another sheet.

Below is the code I have so far, basically this works but I can only copy the cell directly below the header title. How would I define the range from 1 cell below my header to the value of Lastrow1?

Thank you in advance for any help as this one is kicking my butt!!!

Sub CopyPaste2()
'attempt using a fixed range for the column search
Dim LastColumn As Long 'not currently using, but would like a dynamic range
Dim lastrow1 As Long
Dim SEHeaderCell As Range
Dim SEHeader As Range
Application.ScreenUpdating = False
Sheet3.Activate
'find last row
lastrow1 = Sheet3.Range("A" & Rows.Count).End(xlUp).Row
'using fixed range
Set SEHeader = Range("A1:AB1")
For Each SEHeaderCell In SEHeader
If SEHeaderCell.Value = "Location" Then
'Need to select and copy all cells down to "lastrow1" at this point
SEHeaderCell.Offset(1, 0).Select
Selection.Copy
Sheet2.Activate
Range("M2").Select
Selection.PasteSpecial Paste:=xlPasteValues
End If
Next SEHeaderCell
End Sub

can you send example file PLEASE............