Combining one worksheet from multiple CLOSED workbooks to one summary page

Mummafrog

New Member
Joined
Jun 4, 2014
Messages
23
I need to take the the information on one worksheet from each of (up to) 31 files ... (one per day each month).

Each of these worksheets is formatted exactly the same, and always contains a heading row, but may or may not contain data, dependent on whether certain conditions were met.

I have made an individual worksheet, so that the user can pick the client/month/year of the data required and then simply push a button to receive the data.

The path is dependent on which client is requesting the data, as such I have pointed the path to cells on an information sheet which is populated dependent on the choices made. One such path could be ..

(S:\Client\Operations\DCR\04 Oct\2017\)

All of the files that are required to be merged are in the format (Client date .xlsm)

I have 4 cells on the Information sheet that populate with each part of the path (Client .. Month .. Year .. Pattern)

I have tried many different ways, the most recent follows, and I get no errors, but also no information. A new sheet opens, and sits nicely at A1. What am I doing wrong??

Sub MergeAllWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range


Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)


lblDir = Workbooks("thirdtest.xlsm").Worksheets("Information").Range("K4").Value
lblMonth = Workbooks("thirdtest.xlsm").Worksheets("Information").Range("L4").Value
lblYear = Workbooks("thirdtest.xlsm").Worksheets("Information").Range("M4").Value
lblFile = Workbooks("thirdtest.xlsm").Worksheets("Information").Range("N4").Value

FolderPath = "lblDir & lblMonth & lblYear"


NRow = 1


FileName = Dir(FolderPath & lblFile)


Do While FileName <> ""

Set WorkBk = Workbooks.Open(FolderPath & FileName)


SummarySheet.Range("A" & NRow).Value = FileName


Set SourceRange = WorkBk.Worksheets(Discounted).Range("A:N")


Set DestRange = SummarySheet.Range("B" & NRow)
Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
SourceRange.Columns.Count)


DestRange.Value = SourceRange.Value


NRow = NRow + DestRange.Rows.Count


WorkBk.Close savechanges:=False


FileName = Dir()
Loop


SummarySheet.Columns.AutoFit
End Sub


I am willing to totally scrap this and start over if needs be, just need some help :) Ta
 

Excel Facts

Bring active cell back into view
Start at A1 and select to A9999 while writing a formula, you can't see A1 anymore. Press Ctrl+Backspace to bring active cell into view.
Not sure why it's still blank, there should at least be a value for FolderPath. Try moving the msgbox & see what happens
Code:
Sub MergeAllWorkbooks2()

    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim NRow As Long
    Dim FileName As String
    Dim WorkSht As Worksheet
    Dim sourceRange As Range
    Dim destrange As Range
    Dim lblDir As String, lblMonth As String, lblYear As String, lblFile As String
    
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    With Workbooks("Zfluff.xlsm").Worksheets("Reports")
        lblDir = .Range("K4").Value
        lblMonth = .Range("L4").Value
        lblYear = .Range("M4").Value
        lblFile = .Range("N4").Value
    End With
    
    FolderPath = lblDir & lblMonth & lblYear
   [COLOR=#0000ff] MsgBox FolderPath & vbLf & lblFile[/COLOR]

    NRow = 1
    
    FileName = Dir(FolderPath & lblFile & "*" & ".xlsm")
    Do While FileName <> ""
        Workbooks.Open (FolderPath & FileName)
        Set WorkSht = ActiveWorkbook.Sheets("Discounted")
        SummarySheet.Range("A" & NRow).Value = FileName
        Set sourceRange = WorkSht.Range("A1:N" & WorkSht.Range("N" & Rows.Count).End(xlUp).Row)
        Set destrange = SummarySheet.Range("B" & NRow)
        Set destrange = destrange.Resize(sourceRange.Rows.Count, _
            sourceRange.Columns.Count)
        destrange.Value = sourceRange.Value
        NRow = NRow + destrange.Rows.Count
        ActiveWorkbook.Close savechanges:=False
        FileName = Dir()
    Loop
    
    SummarySheet.Columns.AutoFit
End Sub
 
Upvote 0
Hi Fluff (hope you see this!!)

I have gotten a little further... the code below actually calls the file now, but when it goes to loop, I lose the path .. ie. it just calls the filename, not the full server path

Code:
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim wBk As Workbook
    Dim wSht As Variant
    Dim SummarySheet As Worksheet
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    
    With Workbooks("fifthtest.xlsm").Worksheets("Information")
        lblDir = Range("K5").Value
        lblMonth = Range("L5").Value
        lblYear = Range("M5").Value
        lblFile = Range("N5").Value
    End With
    
    FolderPath = lblDir & lblMonth & lblYear
    
    NRow = 1
    
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    sPath = lblDir & lblMonth & lblYear
    MsgBox sPath
    
    
    
    sFname = sPath & "\" & lblFile & "*.xlsm"
    Dir (sFname)
    MsgBox sFname
    wSht = "Discounted"
    Do While sFname <> ""
    
        Workbooks.Open (sFname)
        Set WorkSht = ActiveWorkbook.Sheets("Discounted")
        SummarySheet.Range("A" & NRow).Value = sFname
        Set SourceRange = WorkSht.Range("A1:N" & WorkSht.Range("N" & Rows.Count).End(xlUp).Row)
        Set DestRange = SummarySheet.Range("B" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
            SourceRange.Columns.Count)
        DestRange.Value = SourceRange.Value
        NRow = NRow + DestRange.Rows.Count
        ActiveWorkbook.Close savechanges:=False
        sFname = Dir()
    Loop
    
    SummarySheet.Columns.AutoFit
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Any more suggestions??
 
Upvote 0
Try
Code:
Sub CombineSheets()
    Dim sPath As String
    Dim sFname As String
    Dim MyFile As String
    Dim wBk As Workbook
    Dim wSht As Variant
    Dim SummarySheet As Worksheet
    

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    
    
    With Workbooks("fifthtest.xlsm").Worksheets("Information")
        lblDir = Range("K5").Value
        lblMonth = Range("L5").Value
        lblYear = Range("M5").Value
        lblFile = Range("N5").Value
    End With
    
    FolderPath = lblDir & lblMonth & lblYear
    
    NRow = 1
    
    Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
    
    sPath = lblDir & lblMonth & lblYear
    MsgBox sPath
    
    
    
    sFname = sPath & "\" & lblFile & "*.xls*"
    [COLOR=#ff0000]MyFile [/COLOR]= Dir(sFname)
    MsgBox MyFile
    wSht = "Discounted"
    Do While [COLOR=#ff0000]MyFile [/COLOR]<> ""
        Workbooks.Open ([COLOR=#ff0000]MyFile[/COLOR])
        Set WorkSht = ActiveWorkbook.Sheets("Discounted")
        SummarySheet.Range("A" & NRow).Value = MyFile
        Set sourceRange = WorkSht.Range("A1:N" & WorkSht.Range("N" & Rows.Count).End(xlUp).Row)
        Set destrange = SummarySheet.Range("B" & NRow)
        Set destrange = destrange.Resize(sourceRange.Rows.Count, _
            sourceRange.Columns.Count)
        destrange.Value = sourceRange.Value
        NRow = NRow + destrange.Rows.Count
        ActiveWorkbook.Close savechanges:=False
        [COLOR=#ff0000]MyFile [/COLOR]= Dir()
    Loop
    
    SummarySheet.Columns.AutoFit
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Changing the code to the above lost the path totally, now even the first one only has the file name, no path at all.
 
Upvote 0
Previous to the changes, (when it was finding the path), it would open the first file, go to the correct worksheet, and copy to the summary sheet. When it tried to loop, it would lose the path, and just look for the filename ie. the first time it would open "S:\blahblah\HO (21) 01-10-17", and when it looped it was just looking for "HO (21) 02-10-17"

After the changes, it does not see the path at all and just tries to open "HO (21) 01-10-17", which it can't find without the path.

I'm so confused .......
 
Upvote 0
Shouldn't make any difference.
The second message box is effectively telling you that a file has been found in the specified directory.
Are any your files password protected?
 
Upvote 0

Forum statistics

Threads
1,224,836
Messages
6,181,251
Members
453,027
Latest member
Lost_in_spreadsheets

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
Back
Top