D
DanSmoach
Hi All
I want to copy the 1st sheet from every workbook in a folder into 1 master
sheet. I have used Ron de Bruins Sample code (Example 11) that I copied
below. The code works perfectly except for when copying from more than 15
sheets (or so) and I get the error "Run time error - Too many different
cell formats" or excel quits and wants to send an error report to Microsoft.
I want to merge sheets from 90+ workbooks.
Here is the code:
Sub CombineWorkbooks()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "C:\Upload Sheets"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy After:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
Any ideas or suggestions would be gratefully received.
Cheers
Dan
I want to copy the 1st sheet from every workbook in a folder into 1 master
sheet. I have used Ron de Bruins Sample code (Example 11) that I copied
below. The code works perfectly except for when copying from more than 15
sheets (or so) and I get the error "Run time error - Too many different
cell formats" or excel quits and wants to send an error report to Microsoft.
I want to merge sheets from 90+ workbooks.
Here is the code:
Sub CombineWorkbooks()
Dim basebook As Workbook
Dim mybook As Workbook
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String
SaveDriveDir = CurDir
MyPath = "C:\Upload Sheets"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
mybook.Worksheets(1).Copy After:= _
basebook.Sheets(basebook.Sheets.Count)
On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0
mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
Any ideas or suggestions would be gratefully received.
Cheers
Dan