Ok, try this one first
Change
MyPath = "C:\Users\Ron\test"
It would be ideal if the "Summary" sheet
could be named without the suffix (simply, 78-000102 in this example).
It will add a number now to the summary sheet
I think about a good sulution for what you want, is the summary sheet always the first sheet in the workbook ?
Sub Example2_More_sheets()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim sh As Worksheet
Dim NewSh As Worksheet
Dim str As String
'Fill in the path\folder where the files are
MyPath = "C:\Users\Ron\test"
'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0
Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop
'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
For Each sh In mybook.Worksheets
Set sourceRange = sh.Range("A1:J10")
Set NewSh = basebook.Worksheets.Add
If LCase(sh.Name) = "summary" Then
str = sh.Name & " " & Fnum
Else
On Error Resume Next
str = Right(sh.Name, Len(sh.Name) - 7)
On Error GoTo 0
End If
On Error Resume Next
NewSh.Name = str
If Err.Number > 0 Then
MsgBox "Change the name of : " & NewSh.Name & " manually"
Err.Clear
End If
On Error GoTo 0
Set destrange = NewSh.Cells(1, "A")
sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the values
' With sourceRange
' Set destrange = NewSh.Cells(1, "A"). _
' Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value
Next sh
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
