Combining data from multiple workbooks

[Prometheus_au]

I have a folder with 440 files.
I would like to stack the data from B6:F30 on every file into a single sheet.

I have the VB code to do this with the data on sheets within a workbook, but now need to have the data moved from seperate workbooks.

Can this be done?

Cheers.

 

[CraigM]

Here is a quick alteration from a similar question this morning.
Change the sFolderPath = "I:\" to suit your folder path.

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 = 5 'Number of Rows to ignore

Set shtPasteSheet = ThisWorkbook.Sheets(1)

sFolderPath = "I:\"

sTempName = Dir(sFolderPath & "*xls")
Do While sTempName <> ""
    Set wbkTempBook = Workbooks.Open(sFolderPath & "\" & sTempName, True, True)
    Set shtTemp = wbkTempBook.Sheets(1)
    lngMaxRow = 30
    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

 

[Prometheus_au]

Thanks CraigM,

After some initial difficulty (with the user not the code) It's working fine and saving heaps of time.

Cheers