XL 2010 Renomer copie de feuilles multiple

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

ascal44

XLDnaute Occasionnel
Bonjour à tous ,

J'ai un classeur , sur lequel j'ai une macro pour copier un nombre de feuilles multiple. Ce peut être une centaine de feuilles .
La feuille copiée et nommée " 1 ". L'idée serait de nommer chaque feuilles copiées avec l'incrémentation : 2 , 3, 4 ,5 etc ....

Voici le code de ma macro :

VB:
Sub CopierFeuilleMultiple()
Dim n As Integer
Dim i As Integer
On Error Resume Next

    n = InputBox("Combien de copies voulez-vous créer?")

    If n > 0 Then
        For i = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
        Next
    End If

End Sub

Merci par avance pour votre aide
 
Bonjour Ascal,
Peut être de cette façon :
VB:
Sub CopierFeuilleMultiple()
Dim n As Integer, i As Integer
On Error Resume Next
Application.ScreenUpdating = False
    n = InputBox("Combien de copies voulez-vous créer?")
    If n > 0 Then
        For i = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
            ActiveSheet.Name = i
        Next
    End If
End Sub
Par contre si les feuilles existent déjà elles seront créées et renommées par ex 1(2).
Tout va dépendre de votre fichier d'origine.
 
Re,
Ou en rajoutant une ligne de code :
VB:
Sub CopierFeuilleMultiple()
Dim n As Integer, i As Integer
On Error Resume Next
Application.ScreenUpdating = False
    n = InputBox("Combien de copies voulez-vous créer?")
    If n > 0 Then
        For i = 1 To n
            ActiveSheet.Copy After:=ActiveWorkbook.Sheets(Worksheets.Count)
            ActiveSheet.Name = i
            ActiveSheet.[C5] = i
        Next
    End If
End Sub
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
5
Affichages
235
Réponses
7
Affichages
211
Réponses
4
Affichages
177
  • Question Question
Microsoft 365 Problème de date
Réponses
5
Affichages
162
Réponses
3
Affichages
672
Retour