Consolidate Workbook

[mwexcel54321]

I am looking to cycle through all workbooks in a folder and move/copy all of the files with the same name. For example, in the picture below, I would like to go through Test 1 - 3 and pull a tab named "TEST" into one workbook.

Sub ConslidateWorkbooks()

Dim FolderPath As String
Dim Filename As String
Dim Sheet As Worksheet
Application.ScreenUpdating = False
FolderPath = Environ("userprofile") & "\Desktop\Test\"
Filename = Dir(FolderPath & "*.xls*")
Do While Filename <> ""
Workbooks.Open Filename:=FolderPath & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
Application.ScreenUpdating = True
End Sub

I have this sos far but it's not as dynamic and easy to use as I'd hoped.

 

[JEC]

Are you pasting all sheets of the Test files in 1 workbook?

 

[JEC]

Alright, if you run this macro you can go to a folder and select the files from which you want to copy your sheets into your source file.
So in this case you select test1, test2 and test3.
Give it a try.

Note: you can multiselect your files in the explorer

Sub jec()
 Dim c00, it As Variant, sh As Worksheet
 Application.ScreenUpdating = False
 
 With Application.FileDialog(msoFileDialogFilePicker)
   .AllowMultiSelect = True
    If .Show Then
       For Each it In .SelectedItems
          With GetObject(it)
            For Each sh In .Sheets
              sh.Copy , ThisWorkbook.Sheets(1)
            Next
           .Close 0
         End With
      Next
    End If
 End With
End Sub

 

[JEC]

I forgot to delete c00 at the declaration at top. You could remove that variable.