Your mrexcel link is broken, it's:
Rename Worksheet based on calculated worksheets | MrExcel Message Board
try:
Code:
Sub BuildTemplateINm()
Application.ScreenUpdating = False
Dim Ws As Worksheet, desWS As Worksheet, rng As Range, lRow As Long, NweShtName As String, ALOIFOTS As Boolean
'unconditionally delete all sheets whose name begins 'TEMPLATE':
Application.DisplayAlerts = False
For Each Ws In Worksheets
If Left(Ws.Name, 8) = "TEMPLATE" Then Ws.Delete
Next Ws
Application.DisplayAlerts = True
'Always add a new TEMPLATE sheet:
Set desWS = Sheets.Add(after:=Sheets(Sheets.Count))
With desWS
.Name = "TEMPLATE"
.Range("A1").Resize(, 2).Value = Array("Description", "Quantity")
End With
NweShtName = "TEMPLATE" 'the future name of this worksheet which will be built upon.
For Each Ws In Sheets
ALOIFOTS = False 'At Least One Item Found On This Sheet
If Left(Ws.Name, 8) <> "TEMPLATE" Then
With Ws
If .Range("H" & .Rows.Count).End(xlUp).Row > 12 Then
For Each rng In .Range("H14", .Range("H" & .Rows.Count).End(xlUp))
If (IsNumeric(rng.Value)) And (rng.Value <> 0) Then
ALOIFOTS = True
With desWS
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 2).Value = Array(rng.Offset(, -6), rng)
End With
End If
Next rng
End If
If .Range("O" & .Rows.Count).End(xlUp).Row > 12 Then
For Each rng In .Range("O14", .Range("O" & .Rows.Count).End(xlUp))
If (IsNumeric(rng.Value)) And (rng.Value <> 0) Then
ALOIFOTS = True
With desWS
.Cells(.Rows.Count, "A").End(xlUp).Offset(1).Resize(, 2).Value = Array(rng.Offset(, -6), rng)
End With
End If
Next rng
End If
End With
End If
If ALOIFOTS Then NweShtName = NweShtName & "-" & Ws.Name
Next Ws
With desWS
.Columns.AutoFit
.Name = NweShtName
End With
Application.ScreenUpdating = True
End Sub