Find header row on the sheet and copy it

[Gwhaou]

Hello,

I need your help, actually i'm using this code to copy data (essentially data on table format vite headers and line of data).

Sub Extract()

' Wrkb_Org for the file which is gonna be copied using msoFileDialogueFilePicker the base file 
' Wrkb_Trs  for the "Template.xlsm" file in which we're gonna copy data 

Dim Wrkb_Org As Workbook
Dim Wrkb_Trs As Workbook
Dim Destination As String
Dim last_line As Long


'Allows only excel file to be openned 
    With Application.FileDialog(msoFileDialogFilePicker)
    .Filters.Add "Excel workbooks", "*.xls*", 1
    
If .Show <> 0 Then

'Took the file selected and active the first sheet (which is supposed to be copied)
        
            Destination = .SelectedItems(1)
                
            Set Wrkb_Org = Workbooks.Open(Destination)
            Set Wrkb_Trs = Workbooks("Template.xlsm")
            Wrkb_Org.Sheets(1).Activate
            
  
'Find the last line to copy from A1 to J last line (which is the table data with the headers)
'But I want here to find the data table automatically without telling where is the table and the headers 

                    Last_line = Wrkb_Org.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
                    Wrkb_Org.Sheets(1).Range("A1:J" & Last_line).Copy
                   
 'Copy and paste it on the template file in which the macro is activated        
                    Wrkb_Trs.Sheets("Sheet_Data").Activate
                    Range("A2").Select
                    ActiveSheet.Paste
 
'Save the base file and close it                    
                    Application.CutCopyMode = False
                    Wrkb_Org.Sheets(1).AutoFilterMode = False
                    Wrkb_Org.Save
                    Wrkb_Org.Close
                    
                    MsgBox " Your data has been correctly transfered"
     
Else

MsgBox ("You have cancelled the transfert")

End If
    
End Sub

In this code I specified the range of the headers to be copied (to the last line of the table)
I need your help, I want to know if it's possible to pickup the table data (with the headers) without specifiying the actual range and let it find automatically.

When it find the table type data, it copy that and past it like one my code

Because I have different types of file in which the table is from A1 to the last line, and other in which they starts a few lines further. you can see that on the images.

I would appreciate some help

 

[Alex Blakenburg]

Your headings look pretty consistent so you could use something like this:

    Dim hdr_line As Long
  
    With Application
        hdr_line = .IfError(.Match("Qsr Jd", Wrkb_Org.Sheets(1).Columns("A"), 0), 0)
        If hdr_line = 0 Then
            MsgBox "Header line not found"
            Exit Sub
        End If
    End With
    last_line = Wrkb_Org.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    Wrkb_Org.Sheets(1).Range("A" & hdr_line & ":J" & last_line).Copy

 

[Gwhaou]

Your headings look pretty consistent so you could use something like this:

    Dim hdr_line As Long
 
    With Application
        hdr_line = .IfError(.Match("Qsr Jd", Wrkb_Org.Sheets(1).Columns("A"), 0), 0)
        If hdr_line = 0 Then
            MsgBox "Header line not found"
            Exit Sub
        End If
    End With
    last_line = Wrkb_Org.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
    Wrkb_Org.Sheets(1).Range("A" & hdr_line & ":J" & last_line).Copy

I'm gonna try that thanks,
So if I understood correctly, the code is trying to find the header starting with "Qsr Jd" end then copy that. But in this case it cares only about the first column A (it's my fault i didn't expose all the cases) what can I do if "Qsr Jd" is not from the column A but anywhere C, E or even W

 

[Alex Blakenburg]

That is why you always need to supply example data that is a "realistic" representation of your actual data.
Try this:

    Dim hdr_line As Long
    Dim hdr_cell
    Dim fndHdr As String
   
    fndHdr = "Qsr Jd"
      
    With Wrkb_Org.Sheets(1)
        Set hdr_cell = .Cells.Find(What:=fndHdr, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                        , SearchFormat:=False)
        If hdr_cell Is Nothing Then
            MsgBox "Header line not found"
            Exit Sub
        End If
        hdr_line = hdr_cell.Row
        last_line = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("A" & hdr_line & ":J" & last_line).Copy
    End With

 

[Gwhaou]

That is why you always need to supply example data that is a "realistic" representation of your actual data.
Try this:

    Dim hdr_line As Long
    Dim hdr_cell
    Dim fndHdr As String
  
    fndHdr = "Qsr Jd"
     
    With Wrkb_Org.Sheets(1)
        Set hdr_cell = .Cells.Find(What:=fndHdr, After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
                        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                        , SearchFormat:=False)
        If hdr_cell Is Nothing Then
            MsgBox "Header line not found"
            Exit Sub
        End If
        hdr_line = hdr_cell.Row
        last_line = .Cells(Rows.Count, "A").End(xlUp).Row
        .Range("A" & hdr_line & ":J" & last_line).Copy
    End With

Sorry for that, the actual sheet has to be confidential, so I created an example file to explain my problem. (In which i failed )

Thank you so much for your help

 

[Alex Blakenburg]

No problem. It's unfortunately a very common hurdle we face.
Let me know how you go.