If you wanted a VBA solution, this code will take all of the
workbooks in a given folder and put them together into one worksheet
in a new workbook called "merged.xls" which is placed on your desktop.
Simply create a folder on your desktop called "merged" and place all
of the workbooks there. It assumes there is only one sheet per
workbook, and your desktop folder is located at "C:\Documents and
Settings\username\Desktop".
It works in Excel 2003, let me know if it works in 2007. Paste
into a standard module (see
http://www.rondebruin.nl/code.htm for
assistance).
Option Explicit
Public Declare Function GetUserName Lib "advapi32.dll" Alias
"GetUserNameA" ( _
ByVal lpBuffer As String, _
nSize As Long) As Long
Public Function Username() As String
Dim lpBuff As String * 1024
GetUserName lpBuff, Len(lpBuff)
Username = Left$(lpBuff, (InStr(1, lpBuff, vbNullChar)) - 1)
End Function
Sub MergeWorkbooks()
'
' this routine will go to a folder called 'merged' on your desktop and
merge all the workbooks in the folder into one
' super workbook called "merged.xls" on your desktop
'
Dim NewWB As Excel.Workbook
Dim FName As String
Dim myLastCell As String, myLastRow As Long, myLastColumn As Long
Dim myRange As String
Dim directoryfiles()
Dim count As Integer
Dim FileN As String
Dim UserN As String, AddRange As Excel.Range
Dim i As Long
Dim rng As Excel.Range
Dim A As Long
UserN = Username
Application.ScreenUpdating = False
' basic error checking
If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged.xls")
<> "" Then
MsgBox ("MERGED.XLS already exists, clear it out before running
this macro"), vbCritical
Exit Sub
End If
If Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\*.xls")
= "" Then
MsgBox ("No XLS files are in the directory." & vbCrLf & "Put some
workbooks there first."), vbCritical
Exit Sub
End If
' build an array of filenames for later processing
FileN = Dir("C:\Documents and Settings\" & UserN & "\Desktop\merged\")
Do
If FileN <> "" Then
ReDim Preserve directoryfiles(count)
directoryfiles(count) = FileN
count = count + 1
End If
FileN = Dir
Loop While FileN <> ""
Set NewWB = Workbooks.Add
ActiveWorkbook.SaveAs "C:\Documents And Settings\" & UserN & "\Desktop
\" & "merged.xls", FileFormat:=xlNormal
Set AddRange = Workbooks("merged.xls").Worksheets(1).Range("A65536")
For i = 0 To UBound(directoryfiles())
Workbooks.Open ("C:\Documents And Settings\" & UserN & "\Desktop
\merged\" & directoryfiles(i))
Set rng = ActiveSheet.UsedRange.Rows
With WorksheetFunction
For A = rng.Rows.count To 1 Step -1
If .CountA(rng.Rows(A).EntireRow) = 0 Then
rng.Rows(A).EntireRow.Delete
Next A
End With
myLastRow = Cells.Find("*", [A1], , , xlByRows,
xlPrevious).Row
myLastColumn = Cells.Find("*", [A1], , , xlByColumns,
xlPrevious).Column
myLastCell = Cells(myLastRow, myLastColumn).Address
myRange = "a1:" & myLastCell
Range(myRange).Copy Destination:=AddRange.End(xlUp).Offset(2,
0)
Workbooks(directoryfiles(i)).Close savechanges:=False
Next i
Workbooks("merged.xls").Close savechanges:=True
MsgBox ("Merge complete!" & vbCrLf & vbCrLf & UBound(directoryfiles())
+ 1 & " workbooks were merged."), vbInformation
If MsgBox("Would you like to delete the separate workbooks?", vbYesNo)
= vbYes Then
For i = 0 To UBound(directoryfiles())
Kill ("C:\Documents And Settings\" & UserN & "\Desktop\merged
\" & directoryfiles(i))
Next i
MsgBox ("Done!"), vbInformation
End If
Set NewWB = Nothing
Set AddRange = Nothing
Set rng = Nothing
Application.ScreenUpdating = True
End Sub
