Move specific tab from multiple workbooks into a single workbook - vba

Question

I have multiple workbooks which all have the tab named "example". I am wanting to adjust my current file to check if the current sheet is named "example", add the name of the workbook in front of "example" e.g. "File1 example" and move this tab into another file.
Currently i have the below, which pulls all tabs from all workbooks into a new workbook.
Sub GetSheets()
Path = "C:\TestPath\"
Filename = Dir(Path & "*.xls")
MsgBox (Filename)
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

Answer 1

Instead of looping through all sheets of a workbook you can just access it directly if you already know its name.
Also make sure not to exceed the max length that is allowed for a worksheet name. This is 31 characters so trim the workbook name or you might run into errors.
Public Sub GetSheets()
Dim Path As String
Path = "C:\TestPath\"
Dim Filename As String
Filename = Dir(Path & "*.xls")
Dim ws As Worksheet
MsgBox (Filename)
Dim OpenWb As Workbook
Do While Filename <> ""
Set OpenWb = Workbooks.Open(Filename:=Path & Filename, ReadOnly:=True)
OpenWb.Worksheets("example").Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'copy after last sheet
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = Left$(OpenWb.Name, 31) 'don't exceed max allowed length
OpenWb.Close False 'we do not save changes in the opened Workbook
Filename = Dir()
Loop
End Sub
Note an error handling might be needed if there is a possibility that any of the files has no worksheet named example.

Answer 2

Something like this should work for you.
Sub GetSheets()
Path = "C:\TestPath\"
Filename = Dir(Path & "*.xls")
Dim ws As Worksheet
MsgBox (Filename)
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each ws In ActiveWorkbook.Sheets
If ws.Name = "example" Then 'name of tab
ws.Name = ws.Name & " " & ActiveWorkbook.Name
ws.Copy After:=ThisWorkbook.Sheets(1)
Exit For
End If
Next ws
Workbooks(Filename).Close False 'we do not save changes in the opened Workbook
Filename = Dir()
Loop
End sub