VBA: Combining multiple workbooks & tabs

[Penrav]

Hi,

I need to find a way of combining over 100 workbooks together into one master file. Each of the workbooks have multiple tabs that will need copying over and all have the same format.

"Example 1" & "Example 2" are examples of the files that need combining (all data is made up). You can see the structure of the workbook is the same but the number of lines of data is not consistent between the files. Each tab follows the same format.

"Desired Output" is how I need the files to be combined (i.e. all the data from row 7 and below from the individual files into one master file but retain the same format/structure).

I think a macro would be the best option to help but not sure where to start.

Any help would be appreciated!

 

[ranman256]

paste this code into a module
here the folder path is entered in cell C3.
the final data is below in: ...SaveAs "c:\temp\CombinedData.xls"
(change these as you need)
add button or run manually the macro: CombineFiles

Option Explicit
Private wbSrc As Workbook, wbTarg As Workbook
Sub CombineFiles()
ScanFilesIn1Folder Range("c3").Value
End Sub

Private Sub ScanFilesIn1Folder(ByVal pvStartDir)
Dim FileSystem As Object
Dim Folder As Object
Dim oFile As Object
Dim i As Integer
Dim wbStart As Workbook
If IsNull(pvStartDir) Then
  MsgBox "No start folder"
  Exit Sub
End If
Set wbStart = ActiveWorkbook
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Set Folder = FileSystem.GetFolder(pvStartDir)
Range("K1").Value = "files"
Range("K2").Select
For Each oFile In Folder.Files
   
    If InStr(oFile.Name, ".xls") > 0 Then
       ActiveCell.Value = oFile
       i = i + 1
       
       AddData i, oFile
       
       wbStart.Activate
       ActiveCell.Offset(1, 0).Select  'next row of file trace
    End If
   
skip1:
Next
wbTarg.Activate
wbTarg.Save
MsgBox "Done"
Set oFile = Nothing
Set Folder = Nothing
Set FileSystem = Nothing
Set wbSrc = Nothing
Set wbTarg = Nothing
Set wbStart = Nothing
End Sub

Private Sub AddData(ByVal pvFileNum, ByVal pvFile)
Dim ws As Worksheet
Workbooks.Open pvFile
Set wbSrc = ActiveWorkbook
For Each ws In Sheets
    ws.Activate
   
    If pvFileNum = 1 Then    'use the 1st file as the base sheet
       pvFileNum = 2
       Sheets(1).Select
       Sheets(1).Copy
       ActiveWorkbook.SaveAs "c:\temp\CombinedData.xls"
       Set wbTarg = ActiveWorkbook
       ActiveSheet.Name = "combined"
       Rows("1:5").Delete
       GoSub Move2Btm
    Else
       Rows("1:6").Delete
       Range("A1").Select
       ActiveSheet.UsedRange.Select
       Selection.Copy
       
        wbTarg.Activate
        ActiveSheet.Paste
        Application.CutCopyMode = False
        GoSub Move2Btm
        wbSrc.Activate
    End If
Next
wbSrc.Close False
Set ws = Nothing
Exit Sub
'----------
Move2Btm:
'----------
Range("A1").Select
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Select  'next row
Return
End Sub