This code is shared by EDWARD FERKING JR
Special Thanks to him for sharing this. true-north-usa.com (His Company Website)
We can use below VBA code for same.
Each time we run it, it will insert a new worksheet at the far left of the active workbook and it will vertically summarize (Values and Formats only…aka a static snapshot of) all the worksheets in the active workbook (NOT including any other worksheet summary pages previously generated by the macro).
Sub SummarizeWorkSheets()
Dim wks As Worksheet, sWks As Worksheet, Ur As Range, I As Integer
Dim sWksc As Integer, sWksr As Long, CurrDate As Date, DateStr As String
Application.ScreenUpdating = False: Sheets(1).Select
Set sWks = ActiveWorkbook.Worksheets.Add: CurrDate = Now()
DateStr = Application.Text(CurrDate, "mm dd yyyy hhmmss AM/PM")
sWks.Name = "WbSumry " & DateStr
sWks.Cells(1, 1) = "Workbook Summary of All Worksheets as of " & DateStr
sWks.Cells(1, 1).Font.Size = 22: sWks.Cells(3, 1).Select: ActiveWindow.FreezePanes = True
For Each wks In ActiveWorkbook.Worksheets
If (Not wks.Name Like "WbSumry*") Then
sWks.Activate
sWksr = sWks.UsedRange.Rows.Count: sWksc = sWks.UsedRange.Columns.Count
If sWksc < 40 Then sWksc = 40
sWks.Cells(sWksr + 3, 1) = "Values and Formats From Worksheet [ " & wks.Name & " ]"
sWks.Cells(sWksr + 3, 1).Font.Size = 14
With sWks.Range(Cells(sWksr + 2, 1), Cells(sWksr + 2, sWksc)).Borders(xlEdgeBottom)
.LineStyle = xlDouble: .ColorIndex = xlAutomatic: .TintAndShade = 0: .Weight = xlThick
End With: wks.Activate: Set Ur = wks.UsedRange: Ur.Select: Selection.Copy
sWks.Activate: sWks.Cells(sWksr + 5, 1).Select:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sWksr = sWks.UsedRange.Rows.Count: sWksc = sWks.UsedRange.Columns.Count
End If: sWks.Activate:: Next wks
sWks.Cells(1).Select: ActiveWindow.ScrollRow = 1: Application.ScreenUpdating = True
MsgBox ("Worksheet Summary Complete")
End Sub
Special Thanks to him for sharing this. true-north-usa.com (His Company Website)
We can use below VBA code for same.
Each time we run it, it will insert a new worksheet at the far left of the active workbook and it will vertically summarize (Values and Formats only…aka a static snapshot of) all the worksheets in the active workbook (NOT including any other worksheet summary pages previously generated by the macro).
Sub SummarizeWorkSheets()
Dim wks As Worksheet, sWks As Worksheet, Ur As Range, I As Integer
Dim sWksc As Integer, sWksr As Long, CurrDate As Date, DateStr As String
Application.ScreenUpdating = False: Sheets(1).Select
Set sWks = ActiveWorkbook.Worksheets.Add: CurrDate = Now()
DateStr = Application.Text(CurrDate, "mm dd yyyy hhmmss AM/PM")
sWks.Name = "WbSumry " & DateStr
sWks.Cells(1, 1) = "Workbook Summary of All Worksheets as of " & DateStr
sWks.Cells(1, 1).Font.Size = 22: sWks.Cells(3, 1).Select: ActiveWindow.FreezePanes = True
For Each wks In ActiveWorkbook.Worksheets
If (Not wks.Name Like "WbSumry*") Then
sWks.Activate
sWksr = sWks.UsedRange.Rows.Count: sWksc = sWks.UsedRange.Columns.Count
If sWksc < 40 Then sWksc = 40
sWks.Cells(sWksr + 3, 1) = "Values and Formats From Worksheet [ " & wks.Name & " ]"
sWks.Cells(sWksr + 3, 1).Font.Size = 14
With sWks.Range(Cells(sWksr + 2, 1), Cells(sWksr + 2, sWksc)).Borders(xlEdgeBottom)
.LineStyle = xlDouble: .ColorIndex = xlAutomatic: .TintAndShade = 0: .Weight = xlThick
End With: wks.Activate: Set Ur = wks.UsedRange: Ur.Select: Selection.Copy
sWks.Activate: sWks.Cells(sWksr + 5, 1).Select:
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
sWksr = sWks.UsedRange.Rows.Count: sWksc = sWks.UsedRange.Columns.Count
End If: sWks.Activate:: Next wks
sWks.Cells(1).Select: ActiveWindow.ScrollRow = 1: Application.ScreenUpdating = True
MsgBox ("Worksheet Summary Complete")
End Sub
