[RESOLVED] [MS Excel 2010] Consolidating all 55 workbooks into 1 new workbook

Dear All,

I am currently having 55 workbooks in a folder (ex. “C:\Consolidation”) and each workbook contains 4 worksheets.

Now I need to consolidate the following three sheets 1. Total Consolidation, 2. State level Consolidation and 3. District Level Consolidation from all 55 workbooks and save it in three different sheets in a new workbook in the same folder (i.e. C:\Consolidation). That new file should be names as “COUNTRY LEVEL CONSOLIDATION”.

So now macro should open one workbook at a time and copy three worksheets separately and paste them including the heading (heading should be copied only for the 1st workbook and second workbook onwards no need to copy the headings) into three worksheets in a new workbook named as “COUNTRLY LEVEL CONSOLIDATION”.

When it opens the second workbook, it should again copy three worksheets data and paste them below the data that are already copied from the previous workbook. (Ex: assume that previous workbook data copied till 500 rows in 1st sheet, 150 rows in second sheet and 90 rows in third sheet then, second workbook data should be pasted from row 501 in first sheet, 151 in second sheet and 91 in third sheet excluding headings. This is how it should copy all 55 workbooks data into three work sheets in one workbook. But the current challenge is in each work sheet, the number of rows to copy is different.

I have attached 5 sample workbooks for your reference.

Is it possible to develop a macro to do these tasks? Please help me with the macro code.

Thank you so much for your help in advance.
Amrutha

i guess to start with you need to have 3 arrays 1 for each sheet, then just copy the range of each sheet into each respective array, this will make sure all sheet 1 data is in 1 array, sheet2 data in another etc, once you have all the data, combine the arrays in order, then check if the sheet can hold all the data, then simply put the array into the range(same size as array)

getting the files you will most likely need the filesystem object and some sort of loop

have a try and if you get stuck post back :)

It looks like you know how to, perhaps only need some sort of guidance:

http://support.microsoft.com/kb/141577

First of all thank you so much for replying. I just started learning VBA macros and didn't go that far.

Can some one please give some sample code, so that I can try on that one?

Can someone please help me?

Hi vbfbryce,

Could you please help me with the code? I know you don't even to take more than 10 minutes. Please help me.

nobody is going to do it for you, your going to have to learn it.

try it in steps

1, first make a loop that finds all the files in the folder and gets the path

2, you need some code that takes that path and opens the file and stores the sheets objects

3, code that takes the objects and put the data into an array(s)

4,when thats all finished you need code outside the loop to finish and put all the data together into a new sheet






















4

does it matter what order the workbook data is entered into the consolidated book?
the order, would be the same as the 55 workbooks are opened
if so some change would be required to sort the order of opening the workbooks

Quote:

---

Is it possible to develop a macro to do these tasks?

---

entry level

Code:

---

Dim shts(2)
Dim rw(2) As Long
mypath = "C:\Consolidation\"
Set newb = Workbooks.Add
shts = Array("Total Consolidation", "State level Consolidation", "District Level Consolidation")
'assumes new Workbook will contain 3 sheets by default, if not some sheets will have to be added
newb.Sheets(1).Name = shts(0)
newb.Sheets(2).Name = shts(1)
newb.Sheets(3).Name = shts(2)
rw(0) = 1
rw(1) = 1
rw(2) = 1
fname = Dir(mypath & "*.xls")
Do While Len(fname) > 0
  Set Wb = Workbooks.Open(mypath & fname)
  For s = 0 To 3
    rws = Wb.Sheets(shts(s)).UsedRange.Rows.Count
    cols = Wb.Sheets(shts(s)).UsedRange.Columns.Count
    newb.Sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols).value = Wb.Sheets(s).UsedRange.value
    rw(s) = rw(s) + rws
  Next
  Wb.Close False
  fname = Dir
Loop
newb.SaveAs mypath & "COUNTRY LEVEL CONSOLIDATION.xls"
newb.Close  ' or omit if you want left open

---

this is untested and may contain errors

Quote:

---

nobody is going to do it for you, your going to have to learn it.

---

it is sunday and i am bored, but i hope you will at least study the code and make whatever modifications are necessary

Hi westconn1,

While running this macro, I am getting the following error message stating "Compile error: Can't assign to array" and highlighting "shts" word. Could you please help me to correct this error?

change to
Dim shts

Now I am getting Run-time error '9' script out of range and it is highlighting the following line "newb.Sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols).value = Wb.Sheets(s).UsedRange.value"

the workbook opened does not have a worksheet that exactly matches the names i used in the line above, which i copied from your original post

No. I have checked once again and all three worksheets names are correct and there is no mistake in the names, but still this error is coming

Also in "Total Consolidation" sheet, it is taking 30 columns, but I need to take only A to K (11 columns) and in "District Level Consolidation" sheet I need to copy only 'O to AA' (columns 13)

Quote:

---

Also in "Total Consolidation" sheet, it is taking 30 columns, but I need to take only A to K (11 columns) and in "District Level Consolidation" sheet I need to copy only 'O to AA' (columns 13)

---

i still do not see where you mention this previously

oops my mistake change to
For s = 0 To 2

which columns for state level?

Sorry it was my mistake I didn't mention in my previous thread.

For "Total Consolidation" sheet it should copy from row A6 to K6 and till the last row where data exists
for "State level Consolidation" sheet it should copy from A1 to G1 and till the last row where data exists
for "District Level Consolidation" sheet it should copy from O1 to AA1 and till the last row where data exists

Also macro should copy the headings only for the first time and 2nd time onwards, it should skip headings and copy only data. Please help me westconn1.

as i can not easily test, i am not sure i have all the number of rows correct, you will have to test, check for blank or missing lines between workbook data, or if any rows get overwritten

i am reposting the entire code as it is too messy now to edit

Code:

---

Dim rw(2) As Long
mypath = "C:\Consolidation\"
shts = Array("Total Consolidation", "State level Consolidation", "District Level Consolidation")
Set newb = Workbooks.Add
'assumes new Workbook will contain 3 sheets by default, if not some sheets will have to be added
newb.Sheets(1).Name = shts(0)
newb.Sheets(2).Name = shts(1)
newb.Sheets(3).Name = shts(2)
rw(0) = 1
rw(1) = 1
rw(2) = 1
rng = Array("a6:k", "a2:g", "o2:aa")
cols = Array("11", "7", "13")
heds = Array("a1:k1", "a1:g1", "o1:aa1")
fname = Dir(mypath & "*.xls")
Do While Len(fname) > 0
  Set Wb = Workbooks.Open(mypath & fname)
  For s = 0 To 2
    rws = Wb.Sheets(shts(s)).UsedRange.Rows.Count - 1
    If s = 0 Then rws = rws - 6
    If Not headsdone Then
        newb.Sheets(shts(s)).Range("a1").Resize(, cols).value = Wb.Sheets(shts(s)).Range(heds(s)).value
        headsdone = True
    End If
    newb.Sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols).value = Wb.Sheets(s).Range(rng(s) & rws - 1).value
    rw(s) = rw(s) + rws - 1
  Next
  fname = Dir
Loop
newb.SaveAs mypath & "COUNTRY LEVEL CONSOLIDATION.xls"
newb.Close

---

Thank you so much Sir. I will check and get back to you.

Dear Sir,

I am getting the following error "Run-time error '1004' Application-defined or object defined error and highlighting the following line of code
"newb.sheets(shts(s)).Range("a1").Resize(, cols).Value = wb.sheets(shts(s)).Range(heds(s)).Value"

When I skip the above line of code and move to the next one it is showing another error "Run-time error '9' script out of range" and highlighting the following line of code
"newb.sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols).Value = wb.sheets(s).Range(Rng(s) & rws - 1).Value" Please help me what to do.

I could able to find the mistake in the below lines. The correct code should be:

"newb.sheets(shts(s)).Range("a1").Resize(, cols(s)).Value = wb.sheets(shts(s)).Range(heds(s)).Value"
"newb.sheets(shts(s)).Range("a" & rw(s)).Resize(rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws - 1).Value"

But I have several other problems that are mentioned below

1) Column heading being copied only for 'Total Consolidation' sheet and for other two sheets heading is not being copied (Heading should be copied only for one time for these two sheets).

2) In sheet 'Total Consolidation' data is being copied from row 6, hence at the end for five rows and 11 columns (i.e. A:K) i am seeing #N/A values.

3) Also In sheets 'State level Consolidation' and 'District Level Consolidation' data is being copied from row 2, hence at the end for 'State level Consolidation' sheet 1 row and 7 columns (i.e. A:G) and 'District Level Consolidation' sheet 1 row 13 columns (i.e. A:M) I am seeing these #N/A values.

4) Also these #N/As are counting as rows, so when next sheet data will be copied below these #N/A values which means for every sheet we see #N/As in 6 rows. This is for first sheet. For 2nd & 3rd sheets, one #N/A row being added. Is there a way to avoid these #N/As?

Quote:

---

I could able to find the mistake in the below lines. The correct code should be:

---

i realised i had made that error, during the night

Quote:

---

i am not sure i have all the number of rows correct, you will have to test,

---

change to
rws = Wb.Sheets(shts(s)).UsedRange.Rows.Count - 2

try
change to
if s = 2 then headsdone = True

Quote:

---

#N/As in 6 rows.

---

is all the rows of data copied, or some omitted?

I have removed -6 from the below code, because if I keep -6 then it is not copying last six rows for every worksheet.

If s = 0 Then rws = rws

With this all rows being copied, but still at the bottom I see #N/As for 6 rows

Hi westconn1,

I could able to fix all errors and it is working fine. All credit should go to you!!!!!

Here is the final code below which is tested.

Sub consolidation()

Dim newb As Workbook
Dim wb As Workbook
Dim rws As Long
Dim shts
Dim rw(2) As Long
Dim s As Integer

mypath = "C:\Consolidation\"
shts = Array("Total Consolidation", "State level Consolidation", "District Level Consolidation")
Set newb = Workbooks.Add

newb.sheets(1).Name = shts(0)
newb.sheets(2).Name = shts(1)
newb.sheets(3).Name = shts(2)

rw(0) = 1
rw(1) = 1
rw(2) = 1

Rng = Array("a7:k", "a2:g", "o2:aa")
cols = Array("11", "7", "13")
heds = Array("a6:k6", "a1:g1", "o1:aa1")
fname = Dir(mypath & "*.xls")

Do While Len(fname) > 0
Set wb = Workbooks.Open(mypath & fname)
For s = 0 To 2
rws = wb.sheets(shts(s)).UsedRange.Rows.Count

Headsdone = True

If Headsdone Then
newb.sheets(shts(s)).Range("a1").Resize(, cols(s)).Value = wb.sheets(shts(s)).Range(heds(s)).Value
End If

If s = 0 Then
newb.sheets(shts(s)).Range("a" & rw(s) + 1).Resize(-6 + rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws).Value
rw(s) = rw(s) + rws - 6
End If

If s = 1 Then
newb.sheets(shts(s)).Range("a" & rw(s) + 1).Resize(-1 + rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws).Value
rw(s) = rw(s) + rws - 1
End If

If s = 2 Then
newb.sheets(shts(s)).Range("a" & rw(s) + 1).Resize(-1 + rws, cols(s)).Value = wb.sheets(shts(s)).Range(Rng(s) & rws).Value
rw(s) = rw(s) + rws - 1
End If

Next

wb.Close False
fname = Dir

Loop
newb.SaveAs mypath & "COUNTRY LEVEL CONSOLIDATION.xlsx"

newb.Close

End Sub

Just wanted to know how do I post my code in a seperate window like the way you posted in previous posts 8 & 17 ? Please let me know. So that in my future posts I will also use those options.

use code tags
[/code] at end
[code] at start