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

Muktar888

New Member
Joined
Apr 30, 2017
Messages
17
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:

VBA Code:
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 :

VBA Code:
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!
 

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Rijnsent

Well-known Member
Joined
Oct 17, 2005
Messages
1,300
Office Version
  1. 365
Platform
  1. Windows
Hi Muktar,
something like this (untested code):
VBA 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
 

Watch MrExcel Video

Forum statistics

Threads
1,127,529
Messages
5,625,347
Members
416,096
Latest member
forevans

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top