Test this one :
Code:
Sub Summary_All_Worksheets_With_Formulas()
Dim Sh As Worksheet
Dim Newsh As Worksheet
Dim myCell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim Basebook As Workbook
Dim lr As Long
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set Basebook = ThisWorkbook
Set Newsh = Basebook.Worksheets.Add
On Error Resume Next
Newsh.Name = "Summary-Sheet"
If Err.Number > 0 Then
MsgBox "The Summary sheet already exist in this workbook."
With Application
.DisplayAlerts = False
Newsh.Delete
.DisplayAlerts = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
Exit Sub
End If
RwNum = 1
'The links to the first sheet will start in row 2
For Each Sh In Basebook.Worksheets
If Sh.Name <> Newsh.Name And Sh.Visible Then
lr = Sh.Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Row
ColNum = 1
RwNum = RwNum + 1
Newsh.Cells(RwNum, 1).Value = Sh.Name
'Copy the sheet name in the A column
For Each myCell In Sh.Range("A1,D5:E5,Z10") ' <----Change the range
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & myCell.Address(False, False)
Next myCell
ColNum = ColNum + 1
Newsh.Cells(RwNum, ColNum).Formula = _
"='" & Sh.Name & "'!" & Cells(lr, "D").Address(False, False)
End If
Next Sh
Newsh.UsedRange.Columns.AutoFit
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
Bookmarks