workbook merge - sheet limitation encountered

daveliao

New Member
Joined
Nov 15, 2006
Messages
9
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
 

Some videos you may like

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop

ravishankar

Well-known Member
Joined
Feb 23, 2006
Messages
3,566
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

New Member
Joined
Nov 15, 2006
Messages
9
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

New Member
Joined
Nov 15, 2006
Messages
9
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,228
Messages
5,594,939
Members
413,953
Latest member
Arthur1471

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 MrExcel.com.
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 "mrexcel.com".
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
Top