Combine Workbooks

Submitted by Tommy Miles.

This sample goes through all the Excel files in a specified directory and combines them into a single workbook. It renames the sheets based on the name of the original workbook:

Sub CombineWorkbooks() Dim CurFile As String

Dim DestWB As Workbook

Dim ws As Object 'allows for different sheet types

Const DirLoc As String = "C:\Data\" 'location of files

Application.ScreenUpdating = False

Set DestWB = Workbooks.Add(xlWorksheet)

Do While CurFile <> vbNullString Dim OrigWB As Workbook

Set OrigWB = Workbooks.Open(Filename:=DirLoc & CurFile, ReadOnly:=True)

' Limit to valid sheet names and remove .xls CurFile = Left(Left(CurFile, Len(CurFile) - 4), 29)

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 = Dir

Loop

0 0

Post a comment