Excel Macro to merge files

[dawnd3]

With the help of google I created this module to merge multiple Excel files into one file. Only problem is, it creates a new sheet for each file. Can someone tell me how to edit this code so that it merges into one single spreadsheet? (all files are same number of columns with same headings). I am using Excel 2010

Thank You,

Dawn

Sub GetSheets()
Path = "C:\Users\Dawn\Documents\Mass Blast Emails Aug 2013\"
Filename = Dir(Path & "*.xlsx")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub

 

[SkipVought]

hi,

You are either appending SHEETS, after which you would have a workbook with multiple sheets or you are appending DATE from within sheets, after which you would have a workbook with one sheet and rows of data that corrspond to the data that was on each sheet in the separate workbooks.

Is there only one sheet per workbook?

If the sheet table structure identical for all sheets?

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[mintjulep]

The requirements specification for this was a bit more extensive than what you are doing, but everything you need to do is in there.

Function BrowseForFolder(Optional OpenAt As Variant, Optional Prompt As String) As String
     'Function purpose:  To Browse for a user selected folder.
     'If the "OpenAt" path is provided, open the browser at that directory
     'If the "Promp" is provided it will appear below the dialog header bar.
     'NOTE:  If invalid, it will open at the Desktop level
     
    Dim ShellApp As Object
     
     'Create a file browser window at the default folder
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, Prompt, 0, OpenAt)
     
     'Set the folder to that selected.  (On error in case cancelled)
    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0
     
     'Destroy the Shell Application
    Set ShellApp = Nothing
     
     'Check for invalid or non-entries and send to the Invalid error
     'handler if found
     'Valid selections can begin L: (where L is a letter) or
     '\\ (as in \\servername\sharename.  All others are invalid
    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
        If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
        If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
        GoTo Invalid
    End Select
     
    Exit Function
     
Invalid:
     'If it was determined that the selection was invalid, set to False
    BrowseForFolder = False
     
End Function


Public Function GetFileNames(oPath As String, Optional fExt As String) As String()

'Function Purpose:  Returns an array of the file names in the oPath directory.
'If the optional fExt is provided only files matching the extension are returned.
'If fExt is not provided then all files are returned.

Dim FileArray() As String
Dim fname As String
Dim SlashExt As String
Dim count As Integer

If fExt <> "" Then
    If Left(fExt, 1) = "." Then fExt = Right(fExt, Len(fExt) - 1) 'Allows fExt to be specified with or without "."
    SlashExt = "\*." & fExt
    
    Else
    SlashExt = "\*.*" 'Set extension to all if option fExt is not provided
    
End If

ReDim FileArray(1 To 2)

fname = Dir(oPath & SlashExt) 'Get first file name
count = 0
Do Until fname = ""    ' Start the loop.
    count = count + 1
    ReDim Preserve FileArray(1 To count)
    FileArray(count) = fname
    fname = Dir ' Get next entry.
 Loop
GetFileNames = FileArray
End Function

Public Function LastRow(MySheet As Excel.Worksheet) As Integer
LastRow = MySheet.UsedRange.Rows.count + MySheet.UsedRange.Row - 1
End Function

Sub MashFiles()

'Procedure Purpose:  Consolidate data from multiple spreadheets into a single spreadsheet.
'Works only with ActiveWorkBook.Sheets(1)
'For each of the multiple spreadsheets ActiveWorkBook.Sheets(1).Name is inserted into Column A of the consolidated sheet.

Dim aPath As String
Dim FileArray() As String
Dim i As Long
Dim r As Integer
Dim myxlapp As Object
Dim DestinationFile As String
Dim DestinationFolder As String
Dim MasterIndex As Excel.Workbook
Dim MasterSheet As Excel.Worksheet
Dim PartIndex As Excel.Workbook
Dim PartSheet As Excel.Worksheet


'Select the path containing the files to process and load .xls files into an array
aPath = BrowseForFolder(, "Select Folder with Files for Processing")
FileArray = GetFileNames(aPath, "xls")

'Set up a file to hold the composite
DestinationFile = InputBox("Name for Destination Spreadsheet")
If Right(DestinationFile, 4) <> ".xls" Then DestinationFile = DestinationFile & ".xls"
DestinationFolder = BrowseForFolder(, "Select a folder for the Destination Spreadsheet")

'open an Excel spreadsheet
Set myxlapp = CreateObject("Excel.Application")
Set MasterIndex = myxlapp.Workbooks.Add
Set MasterSheet = MasterIndex.Worksheets(1)
myxlapp.Visible = True

'Run though each file and do stuff
Application.ScreenUpdating = False
For i = 1 To UBound(FileArray)
    fullfilename = aPath & "\" & FileArray(i)
    Set PartIndex = myxlapp.Workbooks.Open(fullfilename)
    Set PartSheet = PartIndex.Sheets(1)
    PartSheet.Columns("A:A").Insert shift:=xlToRight
        For r = 1 To LastRow(PartSheet)
            PartSheet.Cells(r, 1).Value = PartSheet.Name
        Next r
    PartSheet.UsedRange.Copy
    MasterSheet.Range("A1").Cells(LastRow(MasterSheet) + 1, 1).PasteSpecial
    PartIndex.Save
    PartIndex.Close
Next i
MasterIndex.SaveAs (DestinationFolder & "\" & DestinationFile)
Application.ScreenUpdating = True
End Sub

 

[dawnd3]

Hi Skip, I have many workbooks with 1 worksheet of data, that I want to merge into one workbook, as 1 worksheet of data.

Is that what your code does mintjulep?

 

[mintjulep]

Sub MashFiles()

'Procedure Purpose: Consolidate data from multiple spreadheets into a single spreadsheet.
'Works only with ActiveWorkBook.Sheets(1)
'For each of the multiple spreadsheets ActiveWorkBook.Sheets(1).Name is inserted into Column A of the consolidated sheet.

If I understand correctly what you are trying to do then yes, everything you need is there, and more.

You'll need to take out the bits that insert the sheet name into column A. Or just delete column A when your done.

 

[dawnd3]

Thank you for your help on this. I forgot I posted it and just asked something similar. (not quite the same, but looking through this post to see if it provides the answer.) Thanks again.