PDA

View Full Version : Consolidating Workbooks Using List



Slicemahn
09-03-2015, 11:07 PM
Hi,
I have fifty sets of workbooks to combine. A set is two workbooks. Since the workbooks are in different folders, I thought I would just list the names of the workbooks in a sheet and loop through the names via VBA. I have attached a sample workbook with the code I am trying. What I need the code to do is to loop through all the workbook sets on Sheet 1 and combine and rename the file as LPReport Name.

Thanks in advance for your help.

Here is the code I am using


Sub Combine()
Dim DestWb As Workbook
Dim ws As Object
Dim curFile As String
Dim companionFile As String
Dim EndRow As Long
Dim RowStep As Integer
Const LBSummaryDirLoc As String = "C:\Users\user\Documents\LB"
Const LPRepDirLoc As String = "C:\Users\user\Documents\LP"
EndRow = Cells(1048576, 1).End(xlUp).Row
Application.ScreenUpdating = False
For RowStep = 2 To EndRow
Set DestWb = Workbooks.Add(xlWorksheet)
curFile = Dir(LPRepDirLoc & ActiveWorkbook.Cells(RowStep, 2).Value)
companionFile = Dir(LBSummaryDirLoc & ActiveWorkbook.Cells(RowStep, 1).Value)
Dim OrigWb As Workbook
Set OrigWb = Workbooks.Open(Filename:=curFile, ReadOnly:=True)
For Each ws In OrigWb.Sheets
ws.Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
If OrigWb.Sheets.Count > 1 Then
DestWb.Sheets(DestWb.Sheets.Count).Name = curFile & ws.Index
Else
DestWb.Sheets(DestWb.Sheets.Count).Name = curFile
End If
Next
OrigWb.Close SaveChanges:=False
curFile = LPRepDirLoc
Dim NextWb As Workbook
Set NextWb = Workbooks.Open(Filename:=companionFile, ReadOnly:=True)
For Each ws In NextWb.Sheets
ws.Copy After:=DestWb.Sheets(DestWb.Sheets.Count)
If NextWb.Sheets.Count > 1 Then
DestWb.Sheets(DestWb.Sheets.Count).Name = companionFile & ws.Index
Else
DestWb.Sheets(DestWb.Sheets.Count).Name = companionFile
End If
Next
NextWb.Close SaveChanges:=False
companionFile = LBSummaryDirLoc
Next RowStep
Application.DisplayAlerts = False
DestWb.Sheets(1).Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Set DestWb = Nothing
End Sub