Consolidating a specific worksheet from multiple workbooks into one master

Hi guys,

I have multiple worksheets in multiple workbooks....
I need to consolidate a specific worksheet (same name in each workbook) and merge into one new workbook. I have the following macro but I can't seem to figure out how to specify a specific worksheet...

Option Explicit
Public u_sheets As String

Sub Consolidate()

Dim ws As Worksheet
Dim wb As Workbook, NewBook As Workbook
Dim scount As Integer
Dim NewWS As Worksheet
Dim wsSheet As Worksheet
Dim i As Integer
Dim NextName As String
Dim sl As Integer
Dim newfilepath As String
    newfilepath = ""
Dim first_only As Boolean
    first_only = False

Call init

'are we doing the first sheet only?
If u_sheets = "First Sheet Only" Then first_only = True


'Setup
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
'Create new workbook for merged sheets


newfilepath = ThisWorkbook.Path & "\Merged" 'excel will auto append the appropriate extension (xlsx)
Set NewBook = Workbooks.Add
NewBook.SaveAs Filename:=newfilepath

i = 1

'Loop through each open workbook
For Each wb In Workbooks
 
    If wb.Name <> ThisWorkbook.Name And wb.Name <> NewBook.Name And Left(wb.Name, 8) <> "PERSONAL" Then
    
    Dim x As String
    
    'Get name of this workbook
    x = JustText(Left(wb.Name, Len(wb.Name) - 4))
        
        'count sheets in this workbook
        If first_only Then
            scount = 1
        Else
            scount = wb.Sheets.Count
        End If
        
        'Loop through each sheet in Workbook
        For Each ws In wb.Worksheets
        
            'do some naming conventions
            Dim xy As String
            Dim y As String
            
            y = JustText(ws.Name) 'strip out all characters from name
            
            If scount > 1 Then
            
              xy = x + y
              
            Else
              
              xy = x
              
            End If
            
            'check the length of the new name and shorten if needed
            sl = Len(xy)
            
            If sl > 30 Then
            
                xy = Right(x, sl - (sl - 30))
            
            End If
            
            'copy worksheet to new workbook
            ws.Copy After:=NewBook.Worksheets(NewBook.Worksheets.Count)
            
            'rename worksheet
            NewBook.Worksheets(NewBook.Worksheets.Count).Name = xy
            If scount = 1 Then Exit For 'break out of loop if we are only doing one sheet
        
        Next

    End If

Next

'remove all original worksheets
'NewBook.Worksheets("Sheet1").Delete
'NewBook.Worksheets("Sheet2").Delete
'NewBook.Worksheets("Sheet3").Delete


ErrorExit: 'Cleanup
    Application.DisplayAlerts = True    'turn system alerts back on
    Application.EnableEvents = True     'turn other macros back on
    Application.ScreenUpdating = True   'refreshes the screen
    
End Sub

Private Function JustText(text_to_clean As String, Optional upper As Boolean = False)
    'removes all characters except for letters and numbers
    'where
    'text_to_clean is the text to clean
    'upper boolean will return UPPER case if true; false if omitted
   
    'declare and initialize user variables
       
    Dim method As Integer
        'choices:
        '1=remove everything except what is in the leave_these variable
        '2=leave everything except what is specifically removed from the "leave" section
        method = 1
   
    Dim leave_these As String   'only used if method=1
        leave_these = "A-Za-z0-9" 'if you want to allow a space "A-Za-z0-9 "

    'declare and initialize system variables
    Dim temp As String
        temp = text_to_clean
       
    'method
    Select Case method
        Case 1  'remove everything except what is in the leave_these variable
            Dim x As String, y As String, z As String, i As Long
            x = temp
                For i = 1 To Len(x)
                    y = Mid(x, i, 1)
                    If y Like "[" & leave_these & "]" Then z = z & y
                Next i
            temp = z
       
        Case 2  'leave everything except characters below
            'feel free to comment out the lines for items you do not wish to remove, or add new lines as desired
            temp = Replace(temp, ",", "")   'remove commas
            temp = Replace(temp, " ", "")   'remove spaces
            temp = Replace(temp, "-", "")   'remove dashes
            temp = Replace(temp, ":", "")   'remove colon
            temp = Replace(temp, ";", "")   'remove semi-colon
           
    End Select

   
    If upper Then JustText = UCase(temp) Else JustText = temp
   
End Function

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean

On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0

End Function

Private Sub init()
    'initialize all public variables
    u_sheets = Range("u_sheets")

End Sub

any help would be appreciated

Moderator's Note: Welcome to the forum. Btw when posting codes be sure to enclosed the with code tags. Select the codes then hit the "#" symbol. I'll do it for you now. Thanks.