Give this a try:
Option Explicit
Sub CreateSummaries()
Dim ws As Worksheet, wsINDEX As Worksheet, LR As Long, NR As Long
Set wsINDEX = Sheets("Index") 'edit this sheetname as needed to be your summary
wsINDEX.UsedRange.Clear
NR = 1
For Each ws In Worksheets
If ws.Name <> wsINDEX.Name Then
With ws
LR = .Range("B" & .Rows.Count).End(xlUp).Row
.Range("A" & LR + 1).Value = "Total"
.Range("C" & LR + 1).FormulaR1C1 = "=SUM(R2C:R" & LR & "C)"
.Range("C" & LR + 2).FormulaR1C1 = "=R" & LR & "C2 - R2C2"
.Range("C" & LR + 2).NumberFormat = "H:MM:SS"
.Range("C" & LR + 3).FormulaR1C1 = "=R[-1]C*R[-2]C"
.Range("C" & LR + 4).FormulaR1C1 = "=R[-1]C*R[-3]C[4]/1000000"
.Range("G" & LR + 1).FormulaR1C1 = "=AVERAGE(R2C:R" & LR & "C)"
wsINDEX.Range("A" & NR).Value = ws.Name
wsINDEX.Range("B" & NR).Value = .Range("C" & LR + 1).Value
wsINDEX.Range("C" & NR).Value = .Range("C" & LR + 2).Value
wsINDEX.Range("D" & NR).Value = .Range("C" & LR + 3).Value
wsINDEX.Range("E" & NR).Value = .Range("G" & LR + 1).Value
NR = NR + 1
End With
End If
Next ws
wsINDEX.Range("c:c").NumberFormat = "H:MM:SS"
End Sub
Bookmarks