We have earlier divided the data into separate sheets but what about the reverse? Can we consolidate data from various Workbooks in a folder?

Split data into sheets – VBA Excel

Sure. let’s learn two things while we are at it.

  1. Splitting sheets into workbooks
  2. Consolidating them back

Capture1

Say, I want to save these sheets to separate workbooks in a folder of my choice.

Now, first things first, We do not know the code of copying a sheet to a new workbook and saving it, so we record it.

‘———————————

Sub Macro2()

‘ Macro2 Macro


Sheets(“West”).Select
Sheets(“West”).Copy
ChDir “D:\”
ActiveWorkbook.SaveAs Filename:=”D:\West.xls”, FileFormat:=xlExcel8, _
Password:=””, WriteResPassword:=””, ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close
End Sub

‘———————————

See what we get, Now we just need to loop over all sheets to do this recursively.

‘———————————

Sub SaveSheets()

Dim myWorkbook As Workbook

Set myWorkbook = Application.Workbooks(ActiveWorkbook.Name)
‘ This code asks for a folder to save the files

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = “Select a Folder to Store the Reports”
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo nextcode
sItem = .SelectedItems(1)
End With

‘ This is a handy code to loop over worksheets

For Each WS In myWorkbook.Worksheets

‘ See how we pasted code from Macro2 here

Sheets(WS.Name).Select
Sheets(WS.Name).Copy
‘ ChDir “D:\” – Not needed

myFileName = sItem & “\” & WS.Name & “.xls”

ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlExcel8, _
Password:=””, WriteResPassword:=””, ReadOnlyRecommended:=False, _
CreateBackup:=False
ActiveWindow.Close

Next WS

nextcode:

End Sub

‘———————————

This is what we get –

Capture2

See how easy it was, It even asked us a location to save…

Now comes the part where we need to combine them back. See how first part of the code is same.

‘———————————

Sub CombineSheets()

Dim myWorkbook As Workbook

Set myWorkbook = Application.Workbooks(ActiveWorkbook.Name)

‘ This code asks for a folder to save the files

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = “Select a Folder to Store the Reports”
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show <> -1 Then GoTo nextcode
sItem = .SelectedItems(1)
End With

Filename = Dir(sItem & “\*.xls”)

Do While Filename <> “”
Workbooks.Open Filename:=sItem & “\” & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=myWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop

nextcode:

End Sub

‘———————————

Run this on a separate workbook else you will get copies in the same workbook

Capture3.JPG

Combine – Divide Sheets – VBA

Now if you want to take it to next level wherein you have folder within folder then refer to this article at StackExchange.

Cheers

CuriousJatin

Advertisements