Excel Gurus - Merging Workbooks

Soldato
Joined
13 Apr 2004
Posts
5,086
Location
London
I have a bunch of Excel files in the following format:
X:\Files\YYYY\FileYYMMDD.xls

They all only contain one sheet with two columns of data.

Is there a way I can merge them all rather than going through, opening each one, and copying and pasting into a new workbook?
 
For anyone that was interested I used two macros.

The first one combines all open workbooks into one workbook with separate sheets for each one.
Code:
Sub Combine()
Dim NewFileName As String
Dim c As Integer
Dim SheetCount As Integer
NewFileName = ActiveWorkbook.Name
c = 1
Do Until c = 0
If Windows(c).Visible = True Then
Windows(c).Activate
MsgBox ("New file to be created")
NewFileName = Application.GetSaveAsFilename _
(, "Microsoft Excel Workbook (*.xls),*.xls")
ActiveWorkbook.SaveAs Filename:=NewFileName, _
FileFormat:=xlWorkbookNormal
NewFileName = ActiveWorkbook.Name
ActiveSheet.Select
c = 0
SheetCount = ActiveWorkbook.Sheets.Count
Else
c = c + 1
End If
Loop
For c = 1 To Workbooks.Count
If Windows(c).Parent.Name <> NewFileName And Windows(c).Visible = True Then
Windows(c).Activate
ActiveWorkbook.Sheets.Copy after:=Workbooks(NewFileName).Sheets(SheetCount)
End If
Next c
End Sub

This one merges all sheets into a new sheet, pasting everything one after the other:
Code:
Option Explicit
Sub MergeAll()
Dim ws As Object, NextRow As Long
Application.DisplayAlerts = False
On Error Resume Next
Sheets("Merge").Delete
Application.DisplayAlerts = True
On Error GoTo 0
Worksheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "Merge"
NextRow = 1
    For Each ws In Worksheets
        If ws.Name <> "Merge" Then
            ws.UsedRange.Cells.Copy Sheets("Merge").Range("A" & NextRow)
            NextRow = Sheets("Merge").Range("A" & Rows.Count).End(xlUp).Row + 2
        End If
    Next ws
End Sub

Thanks for looking!
 
Back
Top Bottom