VBA won't paste name to a cell

[jondavis1987]

This is the vba code. It's supposed to create a copy of a worksheet, delete a button that activates all of this from the copy, give a box to name the new worksheet, alphabetize the worksheet, and then paste that worksheet name in the first empty row of Column A in worksheet Mix Design Names. It does everything except put the name in Mix Design Names. What am I doing wrong?

Sub New_Superpave2()
    Sheets("Superpave Template").Copy After:=ActiveSheet
    ActiveSheet.Shapes.Range(Array("Option Button 2")).Select
    Selection.Delete
    On Error Resume Next
    ActiveSheet.Name = InputBox("Mix Design Name?")
     
    Dim WS As Worksheet
    Dim lastRow As Long
    
    lastRow = Sheets("Mix Design Names").Cells(Rows.Count, "A").End(xlUp).Row + 1
   Dim strSheetName As String
  strSheetName = ActiveSheet.Name
   Dim SheetMyVar As Worksheet: Set SheetMyVar = ActiveSheet
   
    Sheets("Mix Design Names").Select After:=ActiveSheet
For Each WS In Worksheets

Next WS
   
    Application.ScreenUpdating = False
Dim ShCount As Integer, i As Integer, j As Integer
ShCount = Sheets.Count

For i = 1 To ShCount - 1
    For j = i + 1 To ShCount
        If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
            Sheets(j).Move before:=Sheets(i)
        End If
    Next j
Next i

Application.ScreenUpdating = True
Exit Sub
    Dim wsName As String
      wsName = ActiveSheet.Name
        lastRow = Sheets("Mix Design Names").Cells(Rows.Count, "A").End(xlUp).Row + 1
         WS.Range("A" & lastRow).Value = wsName

SheetMyVar.Select
End Sub

 

[davesexcel]

ActiveSheet.Name = InputBox("Mix Design Name?")

This is asking the user to select a name for the worksheet, "Mix Design Name?" is just the prompt in the inputbox. it is not the sheet variable.

    Dim sh As Worksheet
    Sheets("Superpave Template").Copy After:=ActiveSheet
    Set sh = ActiveSheet
    With sh
        .Name = InputBox("Mix Design Name?")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1


        'other stuff

    End With

 

[jondavis1987]

Finally caught my error after walking away

Sub New_Superpave2()
    Sheets("Superpave Template").Copy After:=ActiveSheet
    ActiveSheet.Shapes.Range(Array("Option Button 2")).Select
    Selection.Delete
    On Error Resume Next
    ActiveSheet.Name = InputBox("Mix Design Name?")
    
    Dim WS As Worksheet
    Dim lastRow As Long
    Dim wsName As String
    wsName = ActiveSheet.Name
    lastRow = Sheets("Mix Design Names").Cells(Rows.Count, "A").End(xlUp).Row + 1
   Dim strSheetName As String
  strSheetName = ActiveSheet.Name
   Dim SheetMyVar As Worksheet: Set SheetMyVar = ActiveSheet
    Sheets("Mix Design Names").Range("A" & lastRow).Value = strSheetName
    Sheets("Mix Design Names").Select After:=ActiveSheet
For Each WS In Worksheets
        
Next WS
   
    Application.ScreenUpdating = False
Dim ShCount As Integer, i As Integer, j As Integer
ShCount = Sheets.Count

For i = 1 To ShCount - 1
    For j = i + 1 To ShCount
        If UCase(Sheets(j).Name) < UCase(Sheets(i).Name) Then
            Sheets(j).Move before:=Sheets(i)
        End If
    Next j
Next i

Application.ScreenUpdating = True
SheetMyVar.Select
End Sub