I have this code to combine multiple CSV files into a single workbook. It works as intended but I was wondering if I could refine it in anyway to possibly have it run any quicker? And also if it could be done without ending up with a blank sheet?

Thank you for looking

Sub CEAST_9340_WIP()'   Charts on specimen #1 worksheet


Dim WkbName             As String
Dim NewWkb              As Workbook
Dim CSVfiles            As Variant
Dim FileCount           As Long
Dim WkbTemp             As Workbook
Dim WsName              As String
Dim LotNumber           As String
Dim SpecimenNumber      As String


    Application.ScreenUpdating = False


'   User Input box to name workbook
    WkbName = InputBox("Name the workbook to store test data", "WORKBOOK NAME")
    
'   Create new workbook with single worksheet
    Set NewWkb = Workbooks.Add(xlWBATWorksheet)
    
'   Exit if dialog box canceled


    If WkbName <> "" Then
        NewWkb.SaveAs FileName:=WkbName '   Save workbook with InputBox info
        WkbName = NewWkb.Name
        Else
        NewWkb.Close '  Close created workbook if InputBox is cancelled
        Exit Sub
    End If
        
'   Rename Sheet1
    'Workbooks(WkbName).Sheets(1).Name = "SummaryData"
    
'   Select Raw Data (*.csv) files
    CSVfiles = Application.GetOpenFilename _
        ("Comma Separated Values File (*.csv), *.csv", _
            Title:="Select which data files to import", MultiSelect:=True)
        
'   Exit macro if no files were selected
    If Not IsArray(CSVfiles) Then
        MsgBox "No file was selected."
        Exit Sub
    End If
    
'   Loop through selected files and add to Results workbook
    For FileCount = LBound(CSVfiles) To UBound(CSVfiles)
    
    Set WkbTemp = Workbooks.Open(FileName:=CSVfiles(FileCount))
        
    Workbooks.OpenText FileName:=CSVfiles(FileCount), _
        Origin:=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, _
        Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1)), TrailingMinusNumbers:=True


'   Moves active sheet to named workbook
    ActiveSheet.Move before:=Workbooks(WkbName).Sheets(FileCount)
    
    If Not ActiveSheet.Range("A2") = "" Then
        LotNumber = GetNumbers(ActiveSheet.Range("A1").Value)
        SpecimenNumber = GetNumbers(ActiveSheet.Range("A2").Value)
        WsName = LotNumber & "_" & SpecimenNumber
        ActiveSheet.Name = WsName
    Else
        WsName = ActiveSheet.Name
    End If
    
    Next FileCount
      
    
    
End Sub
Function GetNumbers(Number As String)


Dim z           As Long
Dim x           As Long
Dim Nmb         As String
Dim NewNmb      As String


    x = Len(Number)
    For z = 1 To x
        Nmb = Mid(Number, z, 1)
        If IsNumeric(Nmb) Then
            NewNmb = NewNmb & Nmb
        End If
    Next z
    
    GetNumbers = NewNmb
    
End Function