workbook merge - sheet limitation encountered

[daveliao]

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?

Thanks.

David





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
Loop

Application.DisplayAlerts = False
'delete empty sheet 1 from the newly created destination workbook
DestWB.Sheets(1).Delete
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
Sheets("Sheet3").Delete
Application.DisplayAlerts = True


Dim sh As Worksheet


For Each sh In Worksheets

If sh.Name <> "Sheet2" Then

Range("A1:Z1").Copy

Sheets("Sheet2").Activate

'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

sh.Activate

Else
End If
Next

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

Sheets("Sheet2").Activate

'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

'amounts
'percentage


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


Application.ScreenUpdating = True
Application.StatusBar = False

End Sub

 

[ravishankar]

Hi
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.
Ravi

 

[daveliao]

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...

Thanks.

 

[daveliao]

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.