Macro to import specific data to a file

[Miguelluis]

Hi I got the below code from a separate thread, however I wanted to amend it to fit some other functions whilst keeping the code as lean as possible:

1. With wbImportWB.Sheets("Extract") - this function imports a sheet with a static name, the data I need to import is in a workbook that contains one tab only but that tab(sheet) changes name everytime. Is there a way to import the data based on whatever file you select not its name?
2. The other thing was I wanted to only import specific data. how do I filter two columns before importing? I need to filter column D to show only blank cells, then filter column F to show "H". Then whatever is left to be imported.

Can you help?

Option Explicit
Sub PasteFalconData()

    Dim wbThisWB    As Workbook
    Dim wbImportWB  As Workbook
    Dim strFullPath As String
    Dim lngLastRow  As Long
    Dim lngLastCol  As Long
  
    Set wbThisWB = ThisWorkbook
  
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False
        .Title = "Please select a file to open:"
        .Filters.Add "Excel and CSV files", "*.csv; *.xls; *.xls*", 1
        .Show
        On Error Resume Next 'In case the user has clicked the  button
            strFullPath = .SelectedItems(1)
            If Err.Number <> 0 Then
                wbThisWB = Nothing
                Exit Sub 'Error has occurred so quit
            End If
        On Error GoTo 0
    End With
  
    Application.ScreenUpdating = False
  
    Set wbImportWB = Workbooks.Open(strFullPath)
    'code here to copy and paste tab from Import WB into the current workbook
    On Error Resume Next 'In case there's no data or tab doesn't exist
        With wbImportWB.Sheets("Extract")
            lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            lngLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
            If lngLastRow > 0 And lngLastCol > 0 Then
                'If the 'lngLastRow' and 'lngLastCol' variable have been set there's data to be copied.
                'The following copies the entire range from tab 'Extract' in the import workbook to cell A1 in 'Sheet1' of this workbook (change to suit).
                Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol)).Copy wbThisWB.Sheets("Sheet1").Cells(1, 1)
            End If
        End With
    On Error GoTo 0
  
    wbImportWB.Close False 'Close the Import WB without saving any changes.
  
    Set wbThisWB = Nothing
    Set wbImportWB = Nothing
  
    Application.ScreenUpdating = True
  
End Sub

 

[npvrader]

In the extract workbook if there is only a single sheet you should be able to address it by its sheet number. So instead of "Extract" , Sheet1. Not sure if it needs to be in quotes

 

[Miguelluis]

In the extract workbook if there is only a single sheet you should be able to address it by its sheet number. So instead of "Extract" , Sheet1. Not sure if it needs to be in quotes

Doesn't work for me with the code above. But is I set the name in the code it works!

 

[Fluff]

Try

With wbImportWB.Sheets(1)

 

[Miguelluis]

Try

With wbImportWB.Sheets(1)

Still nothing I'm afraid!

 

[Fluff]

If the "wbImportWB" file only has one sheet then it will work.
Are you sure that workbook only has the one sheet? No hidden sheets?

 

[Miguelluis]

If the "wbImportWB" file only has one sheet then it will work.
Are you sure that workbook only has the one sheet? No hidden sheets?

yes but the sheet is not called sheet1! and its name changes daily, not sure if that makes any diference to the result!!

 

[Miguelluis]

Now even renaming the file I get nothing:
Option Explicit
Sub PasteFalconData()

Dim wbThisWB As Workbook
Dim wbImportWB As Workbook
Dim strFullPath As String
Dim lngLastRow As Long
Dim lngLastCol As Long

Set wbThisWB = ThisWorkbook

With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Please select a file to open:"
.Filters.Add "Excel and CSV files", "*.csv; *.xls; *.xls*", 1
.Show
On Error Resume Next 'In case the user has clicked the button
strFullPath = .SelectedItems(1)
If Err.Number <> 0 Then
wbThisWB = Nothing
Exit Sub 'Error has occurred so quit
End If
On Error GoTo 0
End With

Application.ScreenUpdating = False

Set wbImportWB = Workbooks.Open(strFullPath)
'code here to copy and paste tab from Import WB into the current workbook
On Error Resume Next 'In case there's no data or tab doesn't exist
With wbImportWB.Sheets(1)
lngLastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lngLastCol = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
If lngLastRow > 0 And lngLastCol > 0 Then
'If the 'lngLastRow' and 'lngLastCol' variable have been set there's data to be copied.
'The following copies the entire range from tab 'Extract' in the import workbook to cell A1 in 'Sheet1' of this workbook (change to suit).
Range(.Cells(1, 1), .Cells(lngLastRow, lngLastCol)).Copy wbThisWB.Sheets("NEWREPORT").Cells(1, 1)
End If
End With
On Error GoTo 0

wbImportWB.Close False 'Close the Import WB without saving any changes.

Set wbThisWB = Nothing
Set wbImportWB = Nothing

Application.ScreenUpdating = True

End Sub

 

[Fluff]

This line

With wbImportWB.Sheets(1)

will look at the first sheet in the workbook, regardless of what it's called.
Try removing this line

On Error Resume Next 'In case there's no data or tab doesn't exist

and see what happens.