workbook merge - sheet limitation encountered


New Member
Nov 15, 2006
Hi All,

I am merging all workbooks within a particular directory. However, I do not reach the second part of this code which consolidates the first row of each merged sheet into the summary sheet (sheet2).

There appears to be a 30 sheet limitation. In other words, I can only merge upt o 30 files before I encounter an error that prevents the procedure from finishing.

Any thoughts?



Sub CreditReportCompile()
'Credit Report Compiler. Take Customer names from multiple docs and merge into a single credit report summary for upload to database.

Application.ScreenUpdating = False
Application.StatusBar = "Compiling..."

'set-up the credit report file based on an active workbook

'display message warning that current data will be lost - confirm

'merge workbooks into single sheet

'for each file listed in the specificed directory

Dim CurFile As String
Dim DestWB As Workbook

'define the location of files to be merged
Const DirLoc As String = "C:\CreditReport\"

'set-up the destination workbook
Set DestWB = Workbooks("Credit Report.xls")

'set the excel files to be merged location variable
CurFile = Dir(DirLoc & "*.xls")

'open the merge files within the defined directory
Do While CurFile <> vbNullString

Dim OrigWB As Workbook

'open the original workbook
Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)

'copy analysis sheet data into fin sheet

'copy/move sheet 1 of the original workbook into the destination sheet (credit report summary workbook)
OrigWB.Sheets("fin").Move After:=DestWB.Sheets(DestWB.Sheets.Count)

'set all requried values to row 1
Range("A1").Value = Range("D5").Value
Range("B1").Value = Range("H6").Value
Range("C1").Value = Range("O5").Value
Range("D1").Value = Range("H8").Value
Range("E1").Value = Range("H9").Value
Range("F1").Value = Range("H11").Value
Range("G1").Value = Range("H17").Value
Range("H1").Value = Range("H26").Value
Range("I1").Value = Range("H30").Value
Range("J1").Value = Range("P16").Value
Range("K1").Value = Range("P8").Value
Range("L1").Value = Range("P23").Value
Range("M1").Value = Range("P24").Value
Range("N1").Value = Range("P29").Value
Range("O1").Value = Range("H34").Value
Range("P1").Value = Range("H36").Value
Range("Q1").Value = Range("H39").Value
Range("R1").Value = Range("H49").Value
Range("S1").Value = Range("P49").Value

'added to calculate sales growth value (found on analysis sheet)
'previous year revenue
Range("Z1").Value = Range("G34").Value

'rename the original workbook name so that it is no longer recognized as an excel file
CurFile = Left(Left(CurFile, Len(CurFile) - 4), 31)

'set the destination sheet name to the name of the original file
DestWB.Sheets(DestWB.Sheets.Count).Name = CurFile

'close the orginal workbook without making any changes
OrigWB.Close SaveChanges:=False

'set the current file directory back to active directory so that an error message does not appear
CurFile = Dir

Application.DisplayAlerts = False
'delete empty sheet 1 from the newly created destination workbook
Application.DisplayAlerts = True

Application.ScreenUpdating = True

Set DestWB = Nothing

'merge workbooks into single sheet -END-

'format each sheet in the newly merged worksheet

Application.DisplayAlerts = False
Application.DisplayAlerts = True

Dim sh As Worksheet

For Each sh In Worksheets

If sh.Name <> "Sheet2" Then



'copy row 1 to first empty row in sheet2
Lastrow = Cells(65536, 1).End(xlUp).Row + 1
Cells(Lastrow, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


End If

'format each sheet in the newly merged worksheet -END-


'calculate sales revenue growth rate

Range("T2").Formula = "=(O2-Z2)/Z2"

'autofill to last row
Range("T2").AutoFill Destination:=Range("T2:T" & Cells(65536, 1).End(xlUp).Row)

'final formatting for summary sheet


'rename summary sheet
Sheets("Sheet2").Name = "Summary"

Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
How many files you have in the folder? Probably the 30th file has some problem and the code is unable to process it. What is the error message you are getting? that will give us a hint to find the solution.
Upvote 0
error message details

Hi Ravi,

The error message I get is:

Microsoft Visual Basic
Runtime error '1004':
Too many different cell formats.

I tested to make sure that it was not specific to any particular one file. I removed what appeared to be the problem file (where the code was stopping) and re-ran the procedure. It stops at the next file following the one that was just removed...

Upvote 0
one more thing

To add to my last thought - when I split the directory into two, each containing about 15-20 files each - the code runs all the way through with each directory.
Upvote 0

Forum statistics

Latest member

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back