Combining several .xls files from a folder

bigdawg

New Member
Joined
Jan 26, 2005
Messages
2
I am attempting to merge several production support logs in .xls format into 1 spreadsheet.

All of the files are in the same folder C:\support\
All files have the same header information in range A1 to V6

I want to combine the data from all of the spreadsheets (minus the heading info) into 1 spreadsheet.

It's gotta be simple - right? :oops:

Thanks in advance for the help[/list]
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.

CraigM

Active Member
Joined
Feb 27, 2003
Messages
320
Try this code out. Paste it into a new workbook, and run it. It will paste all the data from the first sheet of each workbook in your folder (minus headers) into the first sheet of the new workbook. It may not be lightning quick, but it should work. Make sure all of the workbooks to be copied are closed. By the way, There won't be more than 65,536 rows of data in total, will there?

Code:
Sub CollectAll()
On Error GoTo Exit_Line
Application.ScreenUpdating = False
Application.EnableEvents = False

Dim wbkTempBook As Workbook
Dim shtPasteSheet As Worksheet, shtTemp As Worksheet
Dim lngMaxRow As Long, lngCopyRows As Long, lngPasteRow As Long, lngIgnoreRows As Long

lngPasteRow = 7 'Row to start copying to
lngIgnoreRows = 6 'Number of Rows to ignore

Set shtPasteSheet = ThisWorkbook.Sheets(1)

sFolderPath = "C:\support\"

sTempName = Dir(sFolderPath & "\*xls")
Do While sTempName <> ""
    Set wbkTempBook = Workbooks.Open(sFolderPath & "\" & sTempName, True, True)
    Set shtTemp = wbkTempBook.Sheets(1)
    lngMaxRow = shtTemp.Cells.SpecialCells(xlCellTypeLastCell).Row
    lngCopyRows = lngMaxRow - lngIgnoreRows
    If lngMaxRow > lngIgnoreRows Then
        shtTemp.Range("A" & lngIgnoreRows + 1 & ":V" & lngMaxRow).Copy _
            shtPasteSheet.Range("A" & lngPasteRow & ":V" & lngPasteRow + lngCopyRows - 1)
        lngPasteRow = lngPasteRow + lngCopyRows
    End If
    wbkTempBook.Close (False)
    sTempName = Dir
Loop

Exit_Line:
Application.EnableEvents = True
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox Err.Description
End Sub
 

bigdawg

New Member
Joined
Jan 26, 2005
Messages
2
I will give this a go and I do appreciate the help. Most of the files contain 20-25 rows of data - so the 62k limit is safe.
 

Forum statistics

Threads
1,148,526
Messages
5,747,216
Members
424,069
Latest member
kamkwok1hh

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top