Loop: Check for FileName in Folder and Copy Sheet from Another Workbook if match is found

reddsable

New Member
Joined
Jun 3, 2019
Messages
12
Hello everybody. I need some help with the code below.

What I need is this: I have a folder (mDir). In this folder I have several excel files that end with different strings (VB20, NB20 etc). I have a master Workbook (in another folder, not connected to the folder of the excel files) and I want to compare the 4 above mentioned strings (VB20,NB20) with the name of the sheets in my Workbook. If there is a match, then I want Excel to copy the sheet VB20 in the file that ends with "VB20.xlsx". And then copy Sheet NB20 to the file that ends with "NB20.xlsx" and so on. There are many files in the folder, but the end of the file name is always unique. I have the below code, but the code doesn't find any match between the Sheet and the File Name. Any ideas?

VBA Code:
Sub sheetCompare()
    Dim i As Integer
    Dim mDirs As String
    Dim path As String
    Dim MasterFile As Variant, SrcFile As Variant
    Dim file As Variant
    Dim wb As Workbook
    Dim datevar As Variant
    
    Set wb = ThisWorkbook
    MasterFile = ActiveWorkbook.Name
    mDirs = "C:\Users\me\Desktop\Test\Split\" 
    file = Dir(mDirs)
    While (file <> "")
        path = mDirs + file
        Workbooks.Open (path)
        SrcFile = ActiveWorkbook.Name
        datevar = Right(file, 9)
        datevar2 = Left(datevar, 4)
        

        For i = 1 To Workbooks(MasterFile).Sheets.Count
         If datevar2 = Workbooks(MasterFile).Sheets(i).Name Then
               
               wb.Activate
    Sheets(i).Copy Before:=Workbooks(file).Sheets(1)
    Workbooks(file).Close SaveChanges:=True
            End If
        Next i
        Workbooks(file).Close (False)
        file = Dir
    Wend
End Sub
 

Some videos you may like

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
Possible causes based on your code:
- missing references to the concerned workbooks;
- file name ends on a space (ie space between base name and the dot delimiter between base and extension);
- differences between upper and lowercase.

You could solve the latter by replacing this
If datevar2 = Workbooks(MasterFile).Sheets(i).Name Then
with this
VBA Code:
If StrComp(datevar2, Workbooks(MasterFile).Sheets(i).Name, vbTextCompare) = 0 Then


BTW, there is no need to switch between workbooks using the Activate statement. If the correct references have been made, the code can also be shortened.
It looks like your code is in your so called "MasterFile". If so, the code below is a modified version of your code.
VBA Code:
Sub sheetCompare_r2()

    Dim sFileSpec   As String
    Dim sPath       As String
    Dim sFile       As String
    Dim oWbSrc      As Workbook
    Dim oWbDest     As Workbook
    Dim oWs         As Worksheet
    Dim sDatevar    As String

    Set oWbSrc = ThisWorkbook
    sFileSpec = "C:\Users\me\Desktop\Test\Split\*.xls?"
    sFile = Dir(sFileSpec)
    
    While (sFile <> "")
        sPath = Replace(sFileSpec, "*.xls?", sFile)
        Set oWbDest = Workbooks.Open(sPath)
        sDatevar = Right(Left(sFile, (InStrRev(sFile, ".")) - 1), 4)
        For Each oWs In oWbSrc.Worksheets
            If StrComp(sDatevar, oWs.Name, vbTextCompare) = 0 Then
                oWs.Copy Before:=oWbDest.Sheets(1)
                oWbDest.Save
            End If
        Next oWs
        oWbDest.Close SaveChanges:=False
        sFile = Dir
    Wend
End Sub
 

reddsable

New Member
Joined
Jun 3, 2019
Messages
12
Possible causes based on your code:
- missing references to the concerned workbooks;
- file name ends on a space (ie space between base name and the dot delimiter between base and extension);
- differences between upper and lowercase.

You could solve the latter by replacing this
If datevar2 = Workbooks(MasterFile).Sheets(i).Name Then
with this
VBA Code:
If StrComp(datevar2, Workbooks(MasterFile).Sheets(i).Name, vbTextCompare) = 0 Then


BTW, there is no need to switch between workbooks using the Activate statement. If the correct references have been made, the code can also be shortened.
It looks like your code is in your so called "MasterFile". If so, the code below is a modified version of your code.
VBA Code:
Sub sheetCompare_r2()

    Dim sFileSpec   As String
    Dim sPath       As String
    Dim sFile       As String
    Dim oWbSrc      As Workbook
    Dim oWbDest     As Workbook
    Dim oWs         As Worksheet
    Dim sDatevar    As String

    Set oWbSrc = ThisWorkbook
    sFileSpec = "C:\Users\me\Desktop\Test\Split\*.xls?"
    sFile = Dir(sFileSpec)
   
    While (sFile <> "")
        sPath = Replace(sFileSpec, "*.xls?", sFile)
        Set oWbDest = Workbooks.Open(sPath)
        sDatevar = Right(Left(sFile, (InStrRev(sFile, ".")) - 1), 4)
        For Each oWs In oWbSrc.Worksheets
            If StrComp(sDatevar, oWs.Name, vbTextCompare) = 0 Then
                oWs.Copy Before:=oWbDest.Sheets(1)
                oWbDest.Save
            End If
        Next oWs
        oWbDest.Close SaveChanges:=False
        sFile = Dir
    Wend
End Sub
Thanks a lot! It solved my problem!
 

GWteB

Well-known Member
Joined
Sep 10, 2010
Messages
1,295
Office Version
  1. 2013
Platform
  1. Windows
You are welcome and thanks for letting me know.
 

Watch MrExcel Video

Forum statistics

Threads
1,126,963
Messages
5,621,855
Members
415,862
Latest member
nascaline

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