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

[reddsable]

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?

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

 

[GWteB]

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

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.

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]

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

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.

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]

You are welcome and thanks for letting me know.