Copy sheets from many workbooks found in a folder to one sigle workbook

A very quick VBA code would be following. You will have to run this VBA code in the workbook in which you want all sheets. -

Sub Copy_All_Sheets_From_A_Folder()

    Folder = "C:\Junk\"         'Here goes your path.
    Filename = Dir(Folder & "*.xls*") 'This takes care of your file extensions
    
    Do While Filename <> ""
    
        Workbooks.Open Filename:=Folder & Filename, ReadOnly:=True
        
            For Each Sheet In ActiveWorkbook.Sheets
            Sheet.Copy After:=ThisWorkbook.Sheets(1)
            NewSheetName = Range("D4").Value
            ActiveSheet.Name = NewSheetName
            Next Sheet
        
        Workbooks(Filename).Close
        
        Filename = Dir()
        
    Loop
    
End Sub

Note - This code is a modified version of code found here -

http://www.extendoffice.com/documents/excel/456-combine-multiple-workbooks.html

Hi , I am very new to VB scripts and am trying to copy sheets from several workbooks found in a folder to a single workbook.

The source folder contains files with such names : "Consumption_Daily_140601_080024.xls", "Consumption_Daily_140601_080026.xls", "Consumption_Daily_140601_080029.xls", etc. Each files contains a single sheet.

"Consumption_Daily_" remains constant and a time stamp is added when the files is generated.

I want to copy the sheets in a single work book and rename each copied sheet with the value of its cell D4 which contains a specific site location name.

Hi Mervin,

Alt-F11 to open the VBA editor

Alt-IM to insert a new code module

In the new module, paste the following code

'----------->>
Public Sub Tester()
    Dim FSO As Object
    Dim oFile As Object
    Dim oFiles As Object
    Dim oFolder As Object
    Dim srcWb As Workbook, destWB As Workbook
    Dim srcSH As Worksheet
    Dim srcRng As Range
    Const sPath As String = "C:\MyFolder\"                            '<<==== Change
    Const sName = "Daily_Consumption_Summary.xlsx"
    Const sNameType As String = "Consumption_Daily_*.xls"

    On Error GoTo XIT
    Application.ScreenUpdating = False
    Set destWB = Workbooks.Add
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = FSO.GetFolder(sPath)
    Set oFiles = oFolder.Files
    For Each oFile In oFiles
        With oFile
            If .Name Like sNameType Then
                Set srcWb = Workbooks.Open(oFile)
                Set srcSH = srcWb.Sheets(1)
                Set srcRng = srcSH.Range("D4")
                With destWB
                    srcSH.Copy After:=.Sheets(.Sheets.Count)
                    .Sheets(.Sheets.Count).Name = srcRng.Value
                End With
                srcWb.Close savechanges:=False
            End If
        End With
    Next oFile
    destWB.SaveAs Filename:=sName, FileFormat:=51

XIT:
    On Error GoTo 0
    Application.ScreenUpdating = True
End Sub
'<<===========

Alt-Q to close the VBA editor

Alt-F8 to open the macro window

Select Tester | Run

===

Regards,

Norman