PDA

View Full Version : VBA help in creating a consolidation spread sheet, for multiple files in one folder



Baja524
02-26-2013, 11:46 PM
I currently have "and growing" aprox 100 spreadsheets in one folder named 2013. The spreadsheets have multiple sheets and I would like to consolidate data from selected cells in each spreadsheet and all on sheet1 from each file.
So for instance in folder 2013 there are lets say sheets named "HomeDepot" and "Lowes" etc... Home depot and Lowes are identical spreadsheets. They are pasword protected and have aprox 11 sheets, I would like to compile the data from "Home depot" spreadsheet tab 1 cell a6 and b6 onto one master spreadsheet. and the same data from the Lowes spreadsheet etc.... through all the files in the folder

Please help!

Baja524
02-27-2013, 03:14 AM
here is what I have been trying to work with, Need to only open certain cells not whole page and each file that opens I have to click no on saving large amounts on clipboard because I suppose the file is coping the whole sheet?

Sub ConsolidateAll()

Dim wkbConsol As Workbook
Dim wksConsol As Worksheet
Dim wkbOpen As Workbook
Dim wksOpen As Worksheet
Dim FolderName As String
Dim FileName As String
Dim Cnt As Long

Application.ScreenUpdating = False

Application.StatusBar = "Please wait..."

Set wkbConsol = ActiveWorkbook
Set wksConsol = wkbConsol.Worksheets(1)

'Change the path accordingly
FolderName = "C:\Users\eeem\Desktop\2013\"

If Right(FolderName, 1) <> "\" Then FolderName = FolderName & "\"

FileName = Dir(FolderName & "*.xls")

Cnt = 1
Do While FileName <> ""
If FileName <> wkbConsol.Name Then
Application.StatusBar = "Opening " & FileName & "..."
Set wkbOpen = Workbooks.Open(FolderName & FileName)
Set wksOpen = wkbOpen.Worksheets(1)
Application.StatusBar = "Copying the data from " & FileName & "..."
With wksOpen.UsedRange
If Cnt = 1 Then
.Copy
wksConsol.Cells(1, "A").PasteSpecial Paste:=xlPasteValues
Else
.Offset(1, 0).Resize(.Rows.Count - 1).Copy
wksConsol.Cells(wksConsol.Rows.Count, "A").End(xlUp)(2).PasteSpecial Paste:=xlPasteValues
End If
End With
wkbOpen.Close savechanges:=False
Application.StatusBar = FileName & " closed..."
End If
FileName = Dir
Cnt = Cnt + 1
Loop

Application.StatusBar = False

Application.ScreenUpdating = True

End Sub

bakerman
03-12-2013, 02:57 PM
Since it would be too timeconsuming to open 100 files (and growing) i'd suggest you use a ADO-connection to retrieve the data from the closed workbooks.