Merge multiple workbooks into one sheet Keep formatting create Summary

[Mnet22]

I have the following spreadsheet that will be filled in by various project managers. I need to combine the workbooks into one spreadsheet. The spreadsheet contains two tabs called "Report" and "list"...I only want all the "Report" sheets to be combined into one tab. The report must keep the formatting. I also want to create a summary tab that will combine all the report summaries (B3:O5) of all the reports into one list called "Summary". Any help will be greatly appreciated.

Projects1.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1		Cat A - Project Monitoring Report			<Project Name As per Budget Name>						Date as at:
2
3		Project No	Project Name	Resp PM/Directorate	Stages	Previous Status	Current Status	Completion Date	Forecast Completion Date	Total Expenditure	Project Due Date	% Budget Spent	Forecast Budget	Forecast Variance $/%	Page Ref
4						●	●
5
6		Note: Please fill in everything marked in grey
7
8		Project Information			Project Highlights
9		Project Manager			Project progress
10		Reporting Period			Type	Scope/Benefit	Stakeholder	Schedule	Financial	Resources /Procurement	Issues Under Management	Risks Under Management	Overall
11		Project Objective			Previous Reporting Period
12		PLT Membership			Current Reporting Period
13		Date of previous PLT meeting & attendees			Comment / Explanation of the current status
14
15		Scope
16		No	Variation Summary	Impacts	Approved	Status
17
18
19
20
21
22
23
24
25		Main Stakeholders
26		Stakeholder	Tactic	Benefits	Status
27
28
29
30
31
32
33		Project Schedule
34		Key Project Phase / Deliverable	Original Date	Forecast Date	Key Milestones to Occur	Reason for Change		Legend
35
36
37
38
39
40		Resources Requirements
41		Resource Source	Internal / External	Description	Remarks	Stage & Status
42
43
44
45
46
47		Key Contracts
48		Contract Name	Contract Value	Local Benefit Rating
49
50
51
52
53
54		Procurement Strategy
55		Resource	Procurement Method	Contract Number	Description	Remarks	Stage & Status
56
57
58
59
60
61		Current Issues under Management
62		Issue Number	Description of Issue	Action being undertaken	By Who/When Decision Required	Project Area	Status
63
64
65
66
67		Supporting Project Documentation
68		No.	Document	eDOCS	Status
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83		Whole of Project Budget vs Actual and Forecast
84
Report

Cells with Conditional Formatting
Cell	Condition		Cell Format	Stop If True
F11:M12	Cell Value	contains ""	text	NO
F11:M12	Cell Value	contains ""	text	NO
F11:M12	Cell Value	contains ""	text	NO

Cells with Data Validation
Cell	Allow	Criteria
F11:M12	List	=Lists!$A$2:$A$4

 

[Mnet22]

I found the following code that does what I want except it is not keeping my formatting "autofit and column width". I also want to create a summary tab that will combine all the report summaries (B3:O5) of all the reports into one list called "Summary". Any help will be greatly appreciated.

Option Explicit
Public Sub CombineManyWorkbooksIntoOneWorksheet()
    
    Dim strDirContainingFiles As String, strFile As String, _
        strFilePath As String
    Dim wbkDst As Workbook, wbkSrc As Workbook
    Dim wksDst As Worksheet, wksSrc As Worksheet
    Dim lngIdx As Long, lngSrcLastRow As Long, _
        lngSrcLastCol As Long, lngDstLastRow As Long, _
        lngDstLastCol As Long, lngDstFirstFileRow As Long
    Dim rngSrc As Range, rngDst As Range, rngFile As Range
    Dim colFileNames As Collection
    Set colFileNames = New Collection
    
    'Set references up-front
    strDirContainingFiles = "G:\Maps\WorkingFiles\2021 Projects\Sept 2021\Project test data\" '<~ your folder
    Set wbkDst = Workbooks.Add '<~ Dst is short for destination
    Set wksDst = wbkDst.ActiveSheet
    
    'Store all of the file names in a collection
    strFile = Dir(strDirContainingFiles & "\*.xlsx")
    Do While Len(strFile) > 0
        colFileNames.Add Item:=strFile
        strFile = Dir
    Loop
    
    ''CHECKPOINT: make sure colFileNames has the file names
    'Dim varDebug As Variant
    'For Each varDebug In colFileNames
    '    Debug.Print varDebug
    'Next varDebug
    
    'Now we can start looping through the "source" files
    'and copy their data to our destination sheet
    For lngIdx = 1 To colFileNames.Count
        
        'Assign the file path
        strFilePath = strDirContainingFiles & "\" & colFileNames(lngIdx)
        
        'Open the workbook and store a reference to the data sheet
        Set wbkSrc = Workbooks.Open(strFilePath)
        Set wksSrc = wbkSrc.Worksheets("Report") '<~ change based on your Sheet name
        
        'Identify the last row and last column, then
        'use that info to identify the full data range
        lngSrcLastRow = LastOccupiedRowNum(wksSrc)
        lngSrcLastCol = LastOccupiedColNum(wksSrc)
        With wksSrc
            Set rngSrc = .Range(.Cells(1, 1), .Cells(lngSrcLastRow, _
                                                     lngSrcLastCol))
        End With
        
        ''CHECKPOINT: make sure we have the full source data range
        'wksSrc.Range("A1").Select
        'rngSrc.Select
        
        'If this is the first (1st) loop, we want to keep
        'the header row from the source data, but if not then
        'we want to remove it
        
       ' If lngIdx <> 1 Then
           ' Set rngSrc = rngSrc.Offset(1, 0).Resize(rngSrc.Rows.Count - 1)
       ' End If
        
        ''CHECKPOINT: make sure that we remove the header row
        ''from the source range on every loop that is not
        ''the first one
        'wksSrc.Range("A1").Select
        'rngSrc.Select
        
        'Copy the source data to the destination sheet, aiming
        'for cell A1 on the first loop then one past the
        'last-occupied row in column A on each following loop
        If lngIdx = 1 Then
            lngDstLastRow = 1
            Set rngDst = wksDst.Cells(1, 1)
        Else
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)
        End If
        rngSrc.Copy Destination:=rngDst '<~ this is the copy / paste
        
        'Almost done! We want to add the source file info
        'for each of the data blocks to our destination
        
        'On the first loop, we need to add a "Source Filename" column
        If lngIdx = 1 Then
            lngDstLastCol = LastOccupiedColNum(wksDst)
            wksDst.Cells(1, lngDstLastCol + 1) = "Source Filename"
        End If
        
        'Identify the range that we need to write the source file
        'info to, then write the info
        With wksDst
        
            'The first row we need to write the file info to
            'is the same row where we did our initial paste to
            'the destination file
            lngDstFirstFileRow = lngDstLastRow + 1
            
            'Then, we need to find the NEW last row on the destination
            'sheet, which will be further down (since we pasted more
            'data in)
            lngDstLastRow = LastOccupiedRowNum(wksDst)
            lngDstLastCol = LastOccupiedColNum(wksDst)
            
            'With the info from above, we can create the range
            Set rngFile = .Range(.Cells(lngDstFirstFileRow, lngDstLastCol), _
                                 .Cells(lngDstLastRow, lngDstLastCol))
                                
            ''CHECKPOINT: make sure we have correctly identified
            ''the range where our file names will go
            'wksDst.Range("A1").Select
            'rngFile.Select
                                
            'Now that we have that range identified,
            'we write the file name
            rngFile.Value = wbkSrc.Name
            
        End With
        
        'Close the source workbook and repeat
        wbkSrc.Close SaveChanges:=False
        
    Next lngIdx
    
    'Let the user know that the combination is done!
    MsgBox "Data combined!"
    
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last row
'OUTPUT      : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByRows, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Row
        End With
    Else
        lng = 1
    End If
    LastOccupiedRowNum = lng
End Function

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'INPUT       : Sheet, the worksheet we'll search to find the last column
'OUTPUT      : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
    Dim lng As Long
    If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
        With Sheet
            lng = .Cells.Find(What:="*", _
                              After:=.Range("A1"), _
                              Lookat:=xlPart, _
                              LookIn:=xlFormulas, _
                              SearchOrder:=xlByColumns, _
                              SearchDirection:=xlPrevious, _
                              MatchCase:=False).Column
        End With
    Else
        lng = 1
    End If
    LastOccupiedColNum = lng
End Function