Copier coller un nombre de feuille renommer à la suite

Bonjour,

J'ai ce code qui demande un nombre Z crée un nombre de feuille Z et renomme les feuilles de 1 à Z

Sub Copie_feuille()

Dim i, z

z = InputBox("Nombre de copies ", "Copie")

If z = "" Then

Else

If IsNumeric(z) Then

For i = 2 To z

Sheets("1").Copy After:=Sheets(i + 1)

ActiveSheet.Name = "" & i

Range("K2") = ActiveSheet.Name

Next i

Else

MsgBox "Veuillez entrer un nombre", vbExclamation

End If

End If

Sheets(3).Activate

Range("B5").Select

End Sub

J'aimerais pouvoir réexécuter ce code pour qu'en entrant un nombre Z* une deuxieme fois, un nombre Z* de feuilles s'ajoute aux Z dernières et se renomment de Z à Z+Z* de façon à obtenir des feuilles nommées de 1 à Z+Z*...

Merci!!!!!!!!!!!

Bonjour

A tester

Sub Copie_feuille()
Dim I As Integer, z
Dim NumMax As Integer

  z = InputBox("Nombre de copies ", "Copie")
  If z = "" Then
    Exit Sub
  Else
    If IsNumeric(z) Then
    Application.ScreenUpdating = False
      For I = 1 To Sheets.Count
        If IsNumeric(Sheets(I).Name) Then
          If Val(Sheets(I).Name) > NumMax Then NumMax = Val(Sheets(I).Name)
        End If
      Next I
      For I = NumMax + 1 To NumMax + z
        Sheets("1").Copy After:=Sheets(I + 1)
        ActiveSheet.Name = "" & I
        Range("K2") = ActiveSheet.Name
      Next I
    Else
      MsgBox "Veuillez entrer un nombre", vbExclamation
    End If
  End If
  Sheets(3).Activate
  Range("B5").Select
End Sub