Combining one worksheet from multiple CLOSED workbooks to one summary page

[Mummafrog]

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

 

[Fluff]

The problem is that you are trying to copy entire columns.
Try making this change

Set SourceRange = WorkBk.Worksheets(Discounted).[COLOR=#0000ff]Range("A1").CurrentRegion[/COLOR]

 

[Mummafrog]

I will try this when I get to work tomorrow ... but I *think* I need to avoid column "O", as it contains other information that takes up 5 rows, and is unnecessary for the merge. If that isn't a problem, that's great, but if it is ...

 

[Fluff]

On further thought, what I said in post#2 is probably not your initial problem.
Try this, a message box will open, showing the path & filename. Are they correct

Sub MergeAllWorkbooks()

    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("thirdtest.xlsm").Worksheets("Information")
        lblDir = .Range("K4").Value
        lblMonth = .Range("L4").Value
        lblYear = .Range("M4").Value
        lblFile = .Range("N4").Value
    End With
    
    FolderPath = lblDir & lblMonth & lblYear
    
    NRow = 1
    
    FileName = Dir(FolderPath & lblFile)
    MsgBox FolderPath & FileName
    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

 

[Mummafrog]

Thanks, I'll let you know how it goes ?

 

[Mummafrog]

Morning

The MsgBox shows the correct path ... but has not appended the file pattern

so I get Path\

instead of Path\pattern*.xlsm

 

[Mummafrog]

Ok.... I now have it showing the pattern, but it is trying to open "pattern*.xlsm" literally - not pattern 01-10-17.xlsm, pattern 02-10-17.xlsm etc

It doesn't seem to be recognising the wildcard

 

[Mummafrog]

the files I am trying to open are in the format - (HO)21 01-10-2017.xlsm, so I have been using the pattern "(HO)21*.xlsm"

There are other differently named files in the folder, so I can't just open everything - unless that wouldn't matter as they don't have a tab "Discounted"???

 

[Fluff]

Replace (HO)21*.xlsm, with (HO)21 & Change the line of code below

    FileName = Dir(FolderPath & lblFile [COLOR=#0000ff]& "*" & ".xlsm"[/COLOR])

 

[Mummafrog]

Thanks for your quick and helpful responses ? Once again, I will do this tomorrow, and let you know how it goes