Copy Values From Each Workbook in Folder to a Single Sheet in New Workbook +Workbook names

Hello

I found this code (Copy All Sheets From Each Workbook in Folder to a Single Sheet in New Workbook) and I'd like to use it to get monthly reports through several daily reports.


Can someone help me to modify this code so that it shows the name of the workbook that the data has been derived from in a separate coloumn (r.g. column Z)?

Also, the current code pastes the formulas and values, but I just need the values of the formulas not the actual formulas.

And finally, I don't need the entire pages I just want to copy the cells A1:Y20 of each workbook.

Thanks,

Sub mcrOMACopyAllWbInFolderToActiveSheet()

    Dim cel As Range
    Dim FileName, ws As Worksheet
    Dim rng As Range
    Dim destWB As Workbook
    Dim pPath As String
    Dim ShellApp As Object
    
    ' Get user to select folder where the data you wish copied lies.
    Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, Prompt, 0, OpenAt)
     
    On Error Resume Next
        pPath = ShellApp.self.Path
    On Error GoTo 0
     
    ' everything happens in this block, first check to see if the folder where the data
    ' resides was selected, then open a new workbook, loop through all files in folder
    ' and all sheets within each file, copying them to the newly created workbook
    ' so the data can be formatted for reporting.
    Application.ScreenUpdating = 0
        If pPath = "" Then
        '  Cancel was selected
            MsgBox "Stopping because you did not select a Folder"
            Exit Sub
        End If
        LR = 1
        ' Add new workbook here
        Workbooks.Add
        Set destWB = ActiveWorkbook
            With CreateObject("scripting.filesystemobject")
                ' Loop through all files in folder
                For Each FileName In .getfolder(pPath).Files
                    With Workbooks.Open(FileName)
                        ' Loop through all worksheets in workbook
                        For Each ws In .Sheets
                            ws.UsedRange.Copy destWB.Sheets(1).Cells(LR, 1)
                            LR = destWB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 2
                        Next
                        .Close True
                    End With
                Next
            End With
        Application.ScreenUpdating = 1
End Sub

Untested but give this a try

Sub mcrOMACopyAllWbInFolderToActiveSheet()
 
Dim cel As Range
 Dim FileName, ws As Worksheet
 Dim rng As Range
 Dim destWB As Workbook
 Dim pPath As String
 Dim ShellApp As Object

     ' Get user to select folder where the data you wish copied lies.
     Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, Prompt, 0, OpenAt)
    
     On Error Resume Next
     pPath = ShellApp.self.Path
     On Error GoTo 0
    
     ' everything happens in this block, first check to see if the folder where the data
     ' resides was selected, then open a new workbook, loop through all files in folder
     ' and all sheets within each file, copying them to the newly created workbook
     ' so the data can be formatted for reporting.
     Application.ScreenUpdating = 0
     If pPath = "" Then
        ' Cancel was selected
        MsgBox "Stopping because you did not select a Folder"
      Exit Sub
     End If
     LR = 1
     ' Add new workbook here
     Workbooks.Add
     Set destWB = ActiveWorkbook
     With CreateObject("scripting.filesystemobject")
        ' Loop through all files in folder
        For Each FileName In .getfolder(pPath).Files
            With Workbooks.Open(FileName)
            ' Loop through all worksheets in workbook
            For Each ws In .Sheets
                a = ws.Range("a1:y20")
                With destWB.Sheets(1)
                    .Cells(LR, 1).Resize(UBound(a), UBound(a, 2)) = a
                    .Cells(LR, "z").Resize(UBound(a)) = ws.Name
                    LR = .Cells(Rows.Count, "a").End(xlUp).Row + 2
                End With
            Next
            .Close True
            End With
        Next
     End With
     Application.ScreenUpdating = 1
 End Sub

This works for me

Sub mcrOMACopyAllWbInFolderToActiveSheet()
 
Dim cel As Range
 Dim FileName, ws As Worksheet
 Dim rng As Range
 Dim destWB As Workbook
 Dim pPath As String
 Dim ShellApp As Object
 Dim a As Variant
 
     ' Get user to select folder where the data you wish copied lies.
     Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, Prompt, 0, OpenAt)
    
     On Error Resume Next
     pPath = ShellApp.self.Path
     On Error GoTo 0
    
     ' everything happens in this block, first check to see if the folder where the data
     ' resides was selected, then open a new workbook, loop through all files in folder
     ' and all sheets within each file, copying them to the newly created workbook
     ' so the data can be formatted for reporting.
     Application.ScreenUpdating = 0
     Application.DisplayAlerts = 0
     If pPath = "" Then
        ' Cancel was selected
        MsgBox "Stopping because you did not select a Folder"
      Exit Sub
     End If
     LR = 1
     ' Add new workbook here
     Workbooks.Add
     Set destWB = ActiveWorkbook
     With CreateObject("scripting.filesystemobject")
        ' Loop through all files in folder
        For Each FileName In .getfolder(pPath).Files
            With Workbooks.Open(FileName)
            ' Loop through all worksheets in workbook
            For Each ws In .Sheets
                a = ws.Range("a1:y20").Value
                With destWB.Sheets(1)
                    .Cells(LR, 1).Resize(UBound(a), UBound(a, 2)) = a
                    .Cells(LR, "z").Resize(UBound(a)) = FileName.Name
                    LR = .Cells(Rows.Count, "a").End(xlUp).Row + 2
                End With
            Next
            .Close
            End With
        Next
     End With
     Application.DisplayAlerts = 1
     Application.ScreenUpdating = 1
 End Sub