Merging One Sheet from Multiple Workbooks into One Master

zxox · Apr 9th 2013

I will have about 100 files to merge together that are in one directory. Is it possible to merge all workSHEETS named "Bob" from each workBOOK and end up with just one master file?

Thanks!

I found this code on this web site (forgive me for not sighting a proper reference!). It doesn't work for me. Yes, I changed the directory and it still didn't work. I will have 12 columns (A:L) and differing # of rows in each "Bob" worksheet.

Code

Sub g_CombineMultWB_AllXLSFiles()      ' This Will combine all EMALL XLS files located in the
     '   S:\DMSMS\POMS\Master POMS NIIN Data\Master EMALL Data Files\EMALL Excel Folder
     ' into a single worksheet in a newly created (or previously existing) workbook
     ' LOCATION OF FILES (ACTUAL):
     '      S:\DMSMS\POMS\Master POMS NIIN Data\Master EMALL Data Files\EMALL Excel Folder
    
    Dim i As Integer 
    Dim wbResults As Workbook 
    Dim wbCodeBook As Workbook 
    Dim f As Worksheet, t As Worksheet, nNew As Long, nOld As Long 
    Application.ScreenUpdating = False 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 
    
    On Error Resume Next 
    
     '   Change path To suit
    Const MYFOLDER = "S:\DMSMS\POMS\Master POMS NIIN Data\Master EMALL Data Files\EMALL Excel Folder\" 
     '   Const MYFOLDER = "G:\CDMO\Combine Multiple WB (Emall Data)\Test Data 2\"
     '   Reset to "Combined EMALL Data.xls" workbook and make sure it is open
    Set wbCodeBook = Workbooks.Open(MYFOLDER & "Combined EMALL Data.xls") 
    Set t = wbCodeBook.Sheets(1) 'The sheet to hold all of the data
    t.Rows("2:" & Rows.Count).Clear 'CLEAR ANY OLD DATA
    nOld = 2 'Row to copy data to (starting AFTER the header row)
    With Application.FileSearch 
        .NewSearch 
        .LookIn = MYFOLDER 
        .FileType = msoFileTypeExcelWorkbooks 
        If .Execute > 0 Then 'See if workbooks exist in target folder
            For i = 1 To .FoundFiles.Count 'Loop through all workbooks in target folder
                If .FoundFiles(i) <> wbCodeBook.FullName Then 
                    Set wbResults = Workbooks.Open(.FoundFiles(i)) 
                    Set f = wbResults.Sheets(1) 'Worksheet to process
                    nNew = f.Cells(Rows.Count, 1).End(xlUp).Row 'Last row with entry in column 1
                    If nNew > 1 Then 'This means we have some data
                        If nOld + nNew - 2 <= Rows.Count Then 'This means there's room to copy
                            f.Rows("2:" & nNew).Copy t.Cells(nOld, 1) 
                            nOld = nOld + nNew - 1 
                        Else 
                            MsgBox "There is not enough room to copy the data from " _ 
                            & .FoundFiles(i), vbCritical, "Out of Room" 
                            Exit For 
                        End If 
                    End If 
                End If 
                wbResults.Close False 'Close workbook without saving
            Next i 
        End If 
    End With 
     ' Pretty up the worksheet
    Columns("A:D").Select 
    Range("A6873").Activate 
    Selection.ColumnWidth = 12 
    Range("A1").Select 
    On Error Goto 0 
    Application.ScreenUpdating = True 
    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
    Application.CutCopyMode = False ' Clear last copy
End Sub

Display More

biggree · Apr 9th 2013

Re: Merging One Sheet from Multiple Workbooks into One Master

try the below code:

Code

Sub Button1_Click()
Dim wsMaster As Workbook, xlsFiles As Workbook
Dim Filename As String
Dim File As Integer
Dim r As Long
 
r = 0
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True
        .Title = "Select files to process"
        .Show
        
        If .SelectedItems.Count = 0 Then Exit Sub
        
        Set wsMaster = ActiveWorkbook
        
        For File = 1 To .SelectedItems.Count
            
            Filename = .SelectedItems.Item(File)
            
            If Right(Filename, 4) = ".xls" Or Right(Filename, 5) = ".xlsm" Then
                
                Workbooks.Open Filename, 0, True
                
                Set xlsFiles = ActiveWorkbook
                
                r = wsMaster.Sheets("Sheet2").UsedRange.Rows.Count
                
                xlsFiles.Sheets("BOB").Range("A1:L65000").Copy Destination:=wsMaster.Sheets("Sheet2").Range("A" & r).Offset(1, 0)
                
                xlsFiles.Close SaveChanges:=False 'close without saving
                
            End If
            
        Next File 'go to the next file and repeat the process
        
    End With
    
    Set wsMaster = Nothing
    Set xlsFiles = Nothing
    
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        
    End With
    
End Sub

Display More

Smallman · Apr 9th 2013

Re: Merging One Sheet from Multiple Workbooks into One Master

Hi

The following will do what you are looking for. It makes the assumption that COl A is the column which will have the full listing for Col L. You can change to suit. I have been using this method for years and just tested the below - it works. So if you can't get it to work please find a mirror to see where the error is occuring

Take care

Smallman

Code

Option Explicit
Sub Combine()
Dim fil As String
Dim path As String
Dim owb As Workbook
Dim twb As Workbook


path = "D:\Test\New\"
fil = Dir(path & "*.xls")
Set twb = ThisWorkbook


    Do Until path = ""
        Set owb = Workbooks.Open(path & fil)
        owb.Sheets("Bob").Range("A2:L" & Cells(Rows.Count, 1).End(xlUp).Row).Copy twb.Sheets("Sheet1").Range("A65536").End(xlUp)(2)
        owb.Close False
        fil = Dir
    Loop
End Sub

Display More

zxox · Apr 23rd 2013

Re: Merging One Sheet from Multiple Workbooks into One Master

Thank you, but since I'm on a network at work I can not get these to work. The error I receive is something to do with hidden folders and not being able to execute the commands. UGH! SO FRUSTRATED! I can NOT unhide the folders no mater what I do. I even checked with the IS&T folks to no avail.

Merging One Sheet from Multiple Workbooks into One Master

Participate now!

Share