Loop Through Subfolders - Sub only copies the first positive result in each folder

I have a Sub that works fine except for one thing, it only copies the first file that it comes across that matches the criteria (contains "Test" in the name). When I open up the locals window, I see that the CurrFile object does reflect each different file with "Test" in the name, but for some reason, after it copies and pastes the first one in that particular folder, it skips past the other files even though they meet the same criteria. Say for example I have a folder that contains two subfolders in it, and the first subfolder has files titled Test1.csv, Test2.csv, Test3.csv, the second folder contains Test4.csv, Test5.csv, and Test6.csv, the sub will only copy Test1.csv and Test4.csv. I can't seem to figure out why.

Sub LoopThroughSubfolders()

Dim FSO As Object
Dim Folder As Object
Dim Subfolders As Object
Dim WB As Workbook
Dim MainWB As Workbook
Dim CurrFile As Object

Set MainWB = ThisWorkbook

With Application
    '.ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set Folder = FSO.GetFolder(Environ("USERPROFILE") & "\Desktop\Temp" & "\")
    Set Subfolders = Folder.Subfolders
    
    For Each Subfolders In Subfolders
        Set CurrFile = Subfolders.Files
            For Each CurrFile In CurrFile
                If CurrFile.Name = Dir(Subfolders.Path & "\" & "*Test*.csv") Then
                    Set WB = Workbooks.Open(CurrFile)
                    WB.Activate
                    Range("A1").Select
                    Range("A1").CurrentRegion.Select
                    Selection.Copy
                    MainWB.Activate
                    Worksheets("Sheet1").Select
                    If Range("A2").Value = "" Then
                       Range("A1").Select
                       Else
                       Range("A100000").End(xlUp).Offset(2, 0).Select
                    End If
                    
                    ActiveSheet.Paste
                    WB.Activate
                    Application.CutCopyMode = False
                    WB.Close
                    MainWB.Activate
                End If
            Next
        Next
Set FSO = Nothing
Set Folder = Nothing
Set Subfolders = Nothing
Set WB = Nothing
Set MainWB = Nothing
Set CurrFile = Nothing

End Sub

Code Tags Added
Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found at http://www.excelforum.com/forum-rule...rum-rules.html



(I have added them for you today. Please take a few minutes to read all Forum Rules and comply in the future.)