VBA to Find worksheet based on portion of string name, then copy all data into another sheet

[Muktar888]

Hi All,

Is there a way for a macro to open an excel document, find a sheet based on a portion of a string, activate this sheet,then copy this data into another workbook?

I have code which will find a sheet based on an exact name as below, but in my case the sheet name will change except for a portion of the name of the sheet ("Export_HIV") which stays the same for the exercise:

Sub Open_Export()
 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("Paste").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

Basically with this line :

With wbImportWB.Sheets("Extract")

it needs to find the sheet based on ""Export_HIV" which will always be on the left followed by a date which is variable, hence I cannot set an actual full sheet name...

Thanks!

 

[Rijnsent]

Hi Muktar,
something like this (untested code):

For Each Sht In wbImporWB.Sheets
    If InStr(Sht.Name, "Extract") > 0 Then
        'Found one, do something?
        lngLastRow = Sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
        lngLastCol = Sht.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).
            Sht.Range(Sht.Cells(1, 1), Sht.Cells(lngLastRow, lngLastCol)).Copy wbThisWB.Sheets("Paste").Cells(1, 1)
        End If
        'Continue with the next sheet?
        Exit For 'Not continue, do only 1 sheet
    End If
Next Sht

Basically loop through all sheets and check the name to contain "Extract" with the Instr function. The alternative is a Left function to compare the start of the name with your criterium.
Cheers,
Koen