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

[ammu]

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