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?
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.
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