Looping through Worksheets in Workbook while looking for specific text

MatthewLane412

New Member
Joined
Aug 23, 2017
Messages
24
Working on a macro that will loop through Workbooks in a folder. Within each workbook it will loop through all the sheets looking for a specific string of text. In this case "*Labor*". My sample workbooks, has 3 sheets with "Labor" in the WS name). Once it finds a match the macro will copy and paste the information into the master workbook and append the data at the bottom.

Looping through Workbooks works great when specifying a sheet name. The code isn't working when searching through the sheet names for a key string. My Master sheet has the same data pasted into it 10's of times from the first sheet with "*Labor*" in the name for both workbooks when running the macro.

All help is much appreciated. Thank you


VBA Code:
Sub CopyRangeToMaster

Application.ScreenUpdating = False
    Dim WS As Worksheet
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Dim finRow As String
    Dim LastRow2 As Long
    Dim LastRow3 As Long
    Dim strExtension As String
    Const strPath As String = "C:\Users\E086365\Desktop\Matt Testing VBA\IndividualBusinessCases\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
        For Each WS In ActiveWorkbook.Worksheets
        If ActiveSheet.Name Like "*Labor*" Then
            LastRow = ActiveSheet.Range("CE200000").End(xlUp).Row
            LastRow2 = ActiveSheet.Range("B" & LastRow - 5).End(xlUp).Row
            finRow = wkbDest.Sheets("Labor_Master").Range("B200000").End(xlUp).Row
            ActiveSheet.Range("B7:DE" & LastRow2).Copy
            wkbDest.Sheets("Labor_Master").Range("B" & finRow + 1).PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            End If
            Next WS
            .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
We needed to change activesheet to WS, try this:

VBA Code:
Sub CopyRangeToMaster()

  Application.ScreenUpdating = False
    Dim WS As Worksheet
    Dim wkbDest As Workbook
    Dim wkbSource As Workbook
    Set wkbDest = ThisWorkbook
    Dim LastRow As Long
    Dim finRow As String
    Dim LastRow2 As Long
    Dim LastRow3 As Long
    Dim strExtension As String
    Const strPath As String = "C:\Users\E086365\Desktop\Matt Testing VBA\IndividualBusinessCases\"
    ChDir strPath
    strExtension = Dir("*.xls*")
    Do While strExtension <> ""
        Set wkbSource = Workbooks.Open(strPath & strExtension)
        With wkbSource
          For Each WS In ActiveWorkbook.Worksheets
            If WS.Name Like "*Labor*" Then
              LastRow = WS.Range("CE200000").End(xlUp).Row
              LastRow2 = WS.Range("B" & LastRow - 5).End(xlUp).Row
              finRow = wkbDest.Sheets("Labor_Master").Range("B" & Rows.Count).End(xlUp).Row
              WS.Range("B7:DE" & LastRow2).Copy
              wkbDest.Sheets("Labor_Master").Range("B" & finRow + 1).PasteSpecial xlPasteValues
              Application.CutCopyMode = False
            End If
          Next WS
          .Close savechanges:=False
        End With
        strExtension = Dir
    Loop
  Application.ScreenUpdating = True
End Sub
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,594
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,312
Messages
5,600,887
Members
414,414
Latest member
neil_c

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