麻烦问下强大的吧友 这个怎么实现，不想一个个打字

Option Explicit
Sub abc()
　Dim i, j, m, t, p
　ReDim a(1 To Sheets.Count + 1, 1 To 4)
　For Each i In Sheets
　　If InStr(i.Name, "月") > 0 And InStr(i.Name, "日") > 0 Then
　　　m = m + 1
　　　t = Split(i.Name, "(")
　　　a(m, 1) = t(0): a(m, 3) = i.Name
　　　If UBound(t) = 1 Then
　　　　a(m, 2) = Val(t(1)) * 100
　　　Else
　　　　a(m, 2) = Val(Split(t(0), "月")(1))
　　　End If
　　End If
　Next
　If m = 0 Then MsgBox "!": Exit Sub
　Call bsort(a, 1, m, 1, UBound(a), 1)
　For i = 1 To m
　　If a(i, 1) <> a(i + 1, 1) Then
　　　Call bsort(a, p + 1, i, 1, UBound(a, 2), 2)
　　　t = Split(a(p + 1, 1), "月")
　　　For j = p + 2 To i
　　　　a(j, 4) = t(0) & "月" & (a(p + 1, 2) + (a(j, 2) / 100 - 1)) & "日"
　　　Next
　　　p = i
　　End If
　Next
　For i = 1 To m
　　If Len(a(i, 4)) Then Sheets(a(i, 3)).Name = a(i, 4)
　Next
End Sub
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If a(j, key) > a(j + 1, key) Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function

仅针对此要求
Sub aaa()
Dim i
For i = 2 To Sheets.Count
Sheets(i).Name = "9月" & i + 5 & "日"
Next
End Sub