Copy formats and values instead of just values with existing code

Hi everyone,

I have the following code which does exactly what I need it to do, but copies only worksheet values:

Sub Stuff()
Application.DisplayAlerts = False
    Dim SummarySheet As Worksheet
    Dim FolderPath As String
    Dim SelectedFiles() As Variant
    Dim NRow As Long
    Dim FileName As String
    Dim NFile As Long
    Dim WorkBk As Workbook
    Dim SourceRange As Range
    Dim DestRange As Range
    Dim Lastrow As Long

    Set SummarySheet = Worksheets("Sheet1")
    
    FolderPath = "C:\"
    
    ChDrive FolderPath
    ChDir FolderPath
    
    SelectedFiles = Application.GetOpenFilename(filefilter:="Excel Files (*.xl*), *.xl*", MultiSelect:=True)

    NRow = 1
    
    For NFile = LBound(SelectedFiles) To UBound(SelectedFiles)
        FileName = SelectedFiles(NFile)
        
        Set WorkBk = Workbooks.Open(FileName)
        
        SummarySheet.Range("A" & NRow).Value = FileName
    
    Lastrow = WorkBk.Worksheets(1).Cells.Find(What:="*", _
        After:=WorkBk.Worksheets(1).Cells.Range("A1"), _
        SearchDirection:=xlPrevious, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows).Row
    
        Set SourceRange = WorkBk.Worksheets("ABC").Range("A1:Y" & Application.Min(47, Lastrow))
        
        Set DestRange = SummarySheet.Range("A" & NRow)
        Set DestRange = DestRange.Resize(SourceRange.Rows.Count, SourceRange.Columns.Count)
           
        DestRange.Value = SourceRange.Value

        NRow = NRow + DestRange.Rows.Count
        
        WorkBk.Close savechanges:=False
    Next NFile
    
    SummarySheet.Columns.AutoFit
Application.DisplayAlerts = True
End Sub

What I'd like to do is have this code copy both values AND formats from each workbook selected.

Any ideas?

Thanks!!

That's fantastic. Thanks, Alphafrog. I noticed that while the formats are perfect, the column widths are not. Can it be set so the column widths carry over with the copy?