各位大神，我在运行这段代码的时候，完全没有效果，好像没有运行一样，小弟是菜鸟一枚，搞了几天都没搞定，请大神们帮帮忙吧！！谢谢了！！！
Sub StepChangeTemplate()
Dim Cur As String
Cur = ""
Dim myRow As Long, myColn As Long
Dim tempName As String, HomeTabName As String
tempName = ""
Dim i As Integer
i = 1
Dim sht As Worksheet
' Read home tab name
HomeTabName = ActiveSheet.Name
' Check if active cell = empty or number
If IsEmpty(ActiveCell) = True Or IsNumeric(ActiveCell) = True Then
MsgBox "Wrong Cell" & vbNewLine & "Please re-select"
Else
' Store cell address into variable and convert to coordinates
Cur = ActiveCell.Address
myRow = Range(Cur).Row
myColn = Range(Cur).Column
' Create multiple sheets with same steps
Do While i = 1
' Store parameters
tempName = Sheets(1).Cells(myRow, myColn).Value
TempCellID = Sheets(1).Cells(myRow, myColn - 1).Value
' Create new sheets
Sheets.Add(After:=Sheets(Sheets.Count)).Name = tempName
' hyperlink to coresponding sub-sheet
Sheets(1).Select
Cells(myRow, myColn).Select
Sheets(1).Cells(myRow, myColn).Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & tempName & "'!A1", TextToDisplay:=tempName
' Write parameters into new cells
Sheets(tempName).Range("A1").Value = TempCellID
'Range("B1").Value = tempName ---- no need to write again as hyperlink below syntex TextToDisplay will rewrite the cell
' hyperlink to coresponding main sheet
Sheets(tempName).Select
Range("B1").Select
Sheets(tempName).Range("B1").Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="'" & HomeTabName & "'!A1", TextToDisplay:=tempName
' move cursor to next cell
myRow = myRow + 1
' loop index
If IsEmpty(Sheets(1).Cells(myRow, myColn)) = True Then
i = 0
Else
i = 1
End If ' End if, it will report compile loop error 'loop without DO' without it
Loop ' End Loop
'AutoFit Every Worksheet Column in a Workbook
For Each sht In ThisWorkbook.Worksheets
sht.Cells.EntireColumn.AutoFit
Next sht
End If
End Sub
