求助大佬

'sheet1中为源数据
Option Explicit
Sub 分页转置()
　Dim a, i, j
　Call doevent(False)
　For Each i In Sheets
　　If LCase(i.Name) <> "sheet1" Then i.Delete
　Next
　ReDim b(1 To 26, 1 To 5)
　a = Sheets("sheet1").[a1].CurrentRegion.Resize(, 29).Value
　For i = 2 To UBound(a)
　　For j = 1 To 26
　　　b(j, 1) = a(1, j)
　　　b(j, 2) = a(i, j)
　　Next
　　b(25, 4) = a(1, 27): b(25, 5) = a(i, 27)
　　b(26, 4) = a(1, 28): b(26, 5) = a(i, 28)
　　Sheets.Add
　　With ActiveSheet
　　　.Name = a(i, 29)
　　　.[a1].Resize(UBound(b), 5) = b
　　End With
　Next
　Call doevent(True)
End Sub
Function doevent(flag As Boolean)
　With Application
　　.DisplayAlerts = flag
　　.ScreenUpdating = flag
　End With
End Function