Try:
Sub blah()
Dim Destn As Range, ShtNo As Long, Sht As Worksheet, TTDisplay
'Assumption that active sheet is always the Contents sheeet (it doesn't have to be called 'Contents'.
With ActiveSheet
.UsedRange.Clear
.Range("A1") = "Table of Contents"
.Range("A1").Font.Bold = True
.Columns("A").ColumnWidth = 3.86
.Range("A1").Font.Size = 16
.Range("A1:C1").Borders(xlEdgeBottom).Weight = xlThin
Set Destn = .Range("B3")
ShtNo = 0
For Each Sht In ThisWorkbook.Worksheets
If Sht.Range("A1").Value = "VTH Rabies Vaccination Record" And Sht.Range("A5").Value = "CWID" Then 'it's definitely a record sheet.
ShtNo = ShtNo + 1
If Application.Trim(Sht.Range("B4").Value) = "" Then TTDisplay = "Blank" Else TTDisplay = Application.Trim(Sht.Range("B4").Value)
.Hyperlinks.Add Destn, "", SubAddress:="'" & Sht.Name & "'!A1", TextToDisplay:=TTDisplay
Destn.Offset(, -1).Value = ShtNo
With Destn.Offset(, 1)
.Value = IIf(Left(Sht.Range("E8").Value, 6) = "Action", "no next action date", Sht.Range("E8").Value)
.NumberFormat = "m/d/yyyy" 'or whatever format you want
End With 'Destn.Offset(, 1)
Set Destn = Destn.Offset(1)
End If
Next Sht
.Columns(2).EntireColumn.AutoFit
.Range(.Cells(3, "B"), Destn.Offset(-1, 1)).Sort key1:=.Cells(2, "B"), order1:=xlAscending, Header:=xlNo, Orientation:=1
.Range("A:Z").Font.Name = "Cambria"
End With 'ActiveSheet
End Sub
It no longer matters what the sheets are called since it uses the name in cell B4.