Copying Multiple WorkSheets into 1 Workbook - Ron de Bruin Help
 

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

Copying Multiple WorkSheets into 1 Workbook - Ron de Bruin Help
 

First of all I notice that you have "mybook.Close False". This leaves every
workbook open after the sheet has been copied. After so many workbooks are
residing in memory (15?), Excel starts to complain or simply crashes. I did
not check Ron's code on his website, but I would change that line of code to
read "mybook.Close True" and see if that doesn't cure it.
If problems still persist, try putting in a loop counter and basebook.Save
every 15 loops or so.

Mike F


"DanSmoach" wrote in message
...
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

Copying Multiple WorkSheets into 1 Workbook - Ron de Bruin Help
 

See the link above the example on my site Dan
http://www.rondebruin.nl/copy3.htm#sheet


--
Regards Ron de Bruin
http://www.rondebruin.nl



"DanSmoach" wrote in message ...
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

Copying Multiple WorkSheets into 1 Workbook - Ron de Bruin Help
 

Hi Mike

mybook.Close False
It close the workbook without saving

See the KB link in the reply to the OP


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Mike Fogleman" wrote in message m...
First of all I notice that you have "mybook.Close False". This leaves every workbook open after the sheet has been copied. After
so many workbooks are residing in memory (15?), Excel starts to complain or simply crashes. I did not check Ron's code on his
website, but I would change that line of code to read "mybook.Close True" and see if that doesn't cure it.
If problems still persist, try putting in a loop counter and basebook.Save every 15 loops or so.

Mike F


"DanSmoach" wrote in message ...
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