Make macro smaller

[ste33uka]

Hi could naone make this macro smaller please

Sub RenameSheet()
Dim Sheet As Worksheet
Set Sheet = Worksheets("1 (2)")
Sheet.Name = "2"
Set Sheet = Worksheets("1 (3)")
Sheet.Name = "3"
Set Sheet = Worksheets("1 (4)")
Sheet.Name = "4"
Set Sheet = Worksheets("1 (5)")
Sheet.Name = "5"
Set Sheet = Worksheets("1 (6)")
Sheet.Name = "6"
Set Sheet = Worksheets("1 (7)")
Sheet.Name = "7"
Set Sheet = Worksheets("1 (8)")
Sheet.Name = "8"
Set Sheet = Worksheets("1 (9)")
Sheet.Name = "9"
Set Sheet = Worksheets("1 (10)")
Sheet.Name = "10"
Set Sheet = Worksheets("1 (11)")
Sheet.Name = "11"
Set Sheet = Worksheets("1 (12)")
Sheet.Name = "12"
Set Sheet = Worksheets("1 (13)")
Sheet.Name = "13"
Set Sheet = Worksheets("1 (14)")
Sheet.Name = "14"
Set Sheet = Worksheets("1 (15)")
Sheet.Name = "15"
Set Sheet = Worksheets("1 (16)")
Sheet.Name = "16"
Set Sheet = Worksheets("1 (17)")
Sheet.Name = "17"
Set Sheet = Worksheets("1 (18)")
Sheet.Name = "18"
Set Sheet = Worksheets("1 (19)")
Sheet.Name = "19"
Set Sheet = Worksheets("1 (20)")
Sheet.Name = "20"
Set Sheet = Worksheets("1 (21)")
Sheet.Name = "21"
Set Sheet = Worksheets("1 (22)")
Sheet.Name = "22"
Set Sheet = Worksheets("1 (23)")
Sheet.Name = "23"
Set Sheet = Worksheets("1 (24)")
Sheet.Name = "24"
Set Sheet = Worksheets("1 (25)")
Sheet.Name = "25"
Set Sheet = Worksheets("1 (26)")
Sheet.Name = "26"
Set Sheet = Worksheets("1 (27)")
Sheet.Name = "27"
Set Sheet = Worksheets("1 (28)")
Sheet.Name = "28"
Set Sheet = Worksheets("1 (29)")
Sheet.Name = "29"
Set Sheet = Worksheets("1 (30)")
Sheet.Name = "30"
Set Sheet = Worksheets("1 (31)")
Sheet.Name = "31"
Set Sheet = Worksheets("1 (32)")
Sheet.Name = "32"
Set Sheet = Worksheets("1 (33)")
Sheet.Name = "33"
Set Sheet = Worksheets("1 (34)")
Sheet.Name = "34"
Set Sheet = Worksheets("1 (35)")
Sheet.Name = "35"
Set Sheet = Worksheets("1 (36)")
Sheet.Name = "36"
Set Sheet = Worksheets("1 (37)")
Sheet.Name = "37"
Set Sheet = Worksheets("1 (38)")
Sheet.Name = "38"
Set Sheet = Worksheets("1 (39)")
Sheet.Name = "39"
Set Sheet = Worksheets("1 (40)")
Sheet.Name = "40"
Set Sheet = Worksheets("1 (41)")
Sheet.Name = "41"
Set Sheet = Worksheets("1 (42)")
Sheet.Name = "42"
Set Sheet = Worksheets("1 (43)")
Sheet.Name = "43"
Set Sheet = Worksheets("1 (44)")
Sheet.Name = "44"
Set Sheet = Worksheets("1 (45)")
Sheet.Name = "45"
Set Sheet = Worksheets("1 (46)")
Sheet.Name = "46"
Set Sheet = Worksheets("1 (47)")
Sheet.Name = "47"
Set Sheet = Worksheets("1 (48)")
Sheet.Name = "48"
Set Sheet = Worksheets("1 (49)")
Sheet.Name = "49"
Set Sheet = Worksheets("1 (50)")
Sheet.Name = "50"
Set Sheet = Worksheets("1 (51)")
Sheet.Name = "51"
Set Sheet = Worksheets("1 (52)")
Sheet.Name = "52"
Set Sheet = Worksheets("1 (53)")
Sheet.Name = "53"
Set Sheet = Worksheets("1 (54)")
Sheet.Name = "54"
Set Sheet = Worksheets("1 (55)")
Sheet.Name = "55"
Set Sheet = Worksheets("1 (56)")
Sheet.Name = "56"
Set Sheet = Worksheets("1 (57)")
Sheet.Name = "57"
Set Sheet = Worksheets("1 (58)")
Sheet.Name = "58"
Set Sheet = Worksheets("1 (59)")
Sheet.Name = "59"
Set Sheet = Worksheets("1 (60)")
Sheet.Name = "60"
Set Sheet = Worksheets("1 (61)")
Sheet.Name = "61"
Set Sheet = Worksheets("1 (62)")
Sheet.Name = "62"
Set Sheet = Worksheets("1 (63)")
Sheet.Name = "63"
Set Sheet = Worksheets("1 (64)")
Sheet.Name = "64"
Set Sheet = Worksheets("1 (65)")
Sheet.Name = "65"
Set Sheet = Worksheets("1 (66)")
Sheet.Name = "66"
Set Sheet = Worksheets("1 (67)")
Sheet.Name = "67"
Set Sheet = Worksheets("1 (68)")
Sheet.Name = "68"
Set Sheet = Worksheets("1 (69)")
Sheet.Name = "69"
Set Sheet = Worksheets("1 (70)")
Sheet.Name = "70"
Set Sheet = Worksheets("1 (71)")
Sheet.Name = "71"
Set Sheet = Worksheets("1 (72)")
Sheet.Name = "72"
Set Sheet = Worksheets("1 (73)")
Sheet.Name = "73"
Set Sheet = Worksheets("1 (74)")
Sheet.Name = "74"
Set Sheet = Worksheets("1 (75)")
Sheet.Name = "75"
Set Sheet = Worksheets("1 (76)")
Sheet.Name = "76"
Set Sheet = Worksheets("1 (77)")
Sheet.Name = "77"
Set Sheet = Worksheets("1 (78)")
Sheet.Name = "78"
Set Sheet = Worksheets("1 (79)")
Sheet.Name = "79"
Set Sheet = Worksheets("1 (80)")
Sheet.Name = "80"
Set Sheet = Worksheets("1 (81)")
Sheet.Name = "81"
Set Sheet = Worksheets("1 (82)")
Sheet.Name = "82"
Set Sheet = Worksheets("1 (83)")
Sheet.Name = "83"
Set Sheet = Worksheets("1 (84)")
Sheet.Name = "84"
Set Sheet = Worksheets("1 (85)")
Sheet.Name = "85"
Set Sheet = Worksheets("1 (86)")
Sheet.Name = "86"
Set Sheet = Worksheets("1 (87)")
Sheet.Name = "87"
Set Sheet = Worksheets("1 (88)")
Sheet.Name = "88"
Set Sheet = Worksheets("1 (89)")
Sheet.Name = "89"
Set Sheet = Worksheets("1 (90)")
Sheet.Name = "90"
Set Sheet = Worksheets("1 (91)")
Sheet.Name = "91"
Set Sheet = Worksheets("1 (92)")
Sheet.Name = "92"
Set Sheet = Worksheets("1 (93)")
Sheet.Name = "93"
Set Sheet = Worksheets("1 (94)")
Sheet.Name = "94"
Set Sheet = Worksheets("1 (95)")
Sheet.Name = "95"
Set Sheet = Worksheets("1 (96)")
Sheet.Name = "96"
Set Sheet = Worksheets("1 (97)")
Sheet.Name = "97"
Set Sheet = Worksheets("1 (98)")
Sheet.Name = "98"
Set Sheet = Worksheets("1 (99)")
Sheet.Name = "99"
Set Sheet = Worksheets("1 (100)")
Sheet.Name = "100"
End Sub

 

[Fluff]

How about

Sub ste33uka()
   Dim Ws As Worksheet
   
   For Each Ws In Worksheets
      If Ws.Name Like "1 (*" Then
         Ws.Name = Split(Replace(Ws.Name, ")", ""), "(")(1)
      End If
   Next Ws
End Sub

 

[DanteAmor]

Try this:
Note: It works for sheets from 2 to 100.

Sub RenameSheet()
  Dim i As Long
  For i = 2 To 100
    Sheets("1 (" & i & ")").Name = i
  Next
End Sub

 

[ste33uka]

thanks fluff and danteamor, job done

 

[Fluff]

Glad we could help & thanks for the feedback.