Macro Excel : Copier- renommer- et placer de nouveaux onglets [Résolu]

Signaler
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010
-
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010
-
Salut les Kracks,



<li>Je souhaiterai avoir une formule me permettant de mettre les nouveaux onglets créés après celui existant.
En effet, en utilisant : Sheets.Add.Name = "Divers" celui-ci vient ce placer avant...</li>

 



<li>Peut-être y-en-t-il une permettant de mettre les onglets dans un ordre voulu :
EX :  Divers
 Divers 4
 Divers5
 Divers2
 Divers3 </li>

 



<li>Y-a-t-il une formule moins longue pour copier tout le contenu de l'onglet sur les 6 autres nouveaux onglets : </li>

Sheets("Sheet1").Select
Cells.Select
Selection.Copy
    Sheets.Add.Name ="Divers"
Cells.Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Cells.Select
Selection.Copy
 Sheets.Add.Name="Divers2"
etc...6 fois...


Merci

Douraka outchit, chto mièrvavo litchit .

12 réponses

Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
...

pardon pour le end if

si les noms des feuilles nouvellement créées sont Divers2, Divers3 etc

Sub CopyActiveSheet2OtherSheets()
    Dim i as Long
    Dim sNameSheet As String

    sNameSheet = "Sheet1"
    For i = 1 to 6
        Worksheets(sNameSheet).Copy after:=Worksheets(Sheets.Count)
        Worksheets.Item(Sheets.Count).Name = "Divers" & i + 1 ' le +1 sert a demarer a Divers2, si tu veux commence a Diver1 enleve le.
    Next i
End sub

et pour eviter de d'avoir un ecran qui clignote dans tout les sens durant l'execution de la macro je te propose ce qui suit :


Sub CopyActiveSheet2OtherSheets()
    Application.ScreenUpdating = False

    Dim i as Long

    Dim sNameSheet As String


    sNameSheet = "Sheet1"

    For i = 1 to 6

        Worksheets(sNameSheet).Copy after:=Worksheets(Sheets.Count)

        Worksheets.Item(Sheets.Count).Name = "Divers" & i + 1 ' le
+1 sert a demarer a Divers2, si tu veux commence a Diver1 enleve le.

    Next i
    Application.ScreenUpdating = True

End sub

A+
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Salut,

comme je te l'avai dit je n'ai teste ce code, et il y avait bien 2 erreurs : la 1ere sur la partie qui enleve le nom deja utilise et la 2ieme lorsque la liste ne contient plus que le dernier nom.
Donc pour la 1ere erreur j'ai change de methode et pour 2ieme j'ai rajoute un if.
Enfin cette fois ci j'ai eu le temps de tester et de mon cote ca marche.

Sub CopyActiveSheet2OtherSheets()
    Application.ScreenUpdating = False
    Dim i As Long
    Dim sNameSheet As String, NewSheetName As String, ListSheetName As String
    ListSheetName = "Bill*Coup*Pay*Spec*Tax*Income" 'ici j'utilise un separateur * pour une meilleur lisibilité mais une virgule aurait tres bien fait l'affaire
    sNameSheet = "Sheet1"
    For i = 1 To 6
        Worksheets(sNameSheet).Copy after:=Worksheets(Sheets.Count)
        If i <> 6 Then'tant que i est different de 6
            'on recupere le nom avant le premier separateur "*"
            'la fonction instr va nous renvoyer la position du premier separateur a partir de la gauche
            'la fonction left recupere le nombre de caractere specifié (ici via la fonction instr) a partir de la gauche
            NewSheetName = Left(ListSheetName, InStr(1, ListSheetName, "*") - 1)  '-1 pour ne pas prendre l'*
            'on enleve de la liste le nom deja utilisé en le remplacent par une chaine vide
            ListSheetName = Replace(ListSheetName, NewSheetName & "*", "")
        Else ' si i = 6 il n'y a pas de traitement sur la liste a faire, il suffit juste recuperer le nom restant
            NewSheetName = ListSheetName
        End If
        Worksheets.Item(Sheets.Count).Name = NewSheetName
    Next i
    Application.ScreenUpdating = True
End Sub

A+
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Re,

voici 2 sub exemples pour illustrer tes 2 demandes :

Option Explicit

Sub CreateSheetAfterActiveSheet()
    Dim sNameSheet As String
    
sNameSheet = ActiveSheet.Name
ThisWorkbook.Sheets.Add , Sheets(sNameSheet)

End Sub

Sub CopyActiveSheet2OtherSheets()
    Dim oSheet As Worksheet
    Dim sNameSheet As String

sNameSheet = "Feuil1"
Sheets(sNameSheet).Select
ActiveSheet.Cells.Copy
For Each oSheet In ThisWorkbook.Sheets
    If oSheet.Name <> sNameSheet Then
        oSheet.Paste
    End If
Next oSheet
End Sub
~
<small>Mortalino ~ [code.aspx?ID=39466 Colorisation
automatique]</small>

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010

Bonjour Mortalino,


J'ai un bug error 1004 sur :
                                       
  Sub CopyActiveSheet2OtherSheets()
    Dim oSheet As Worksheet
    Dim sNameSheet As String


sNameSheet = "Sheet1"
Sheets(sNameSheet).Select
ActiveSheet.Cells.Copy
For Each oSheet In ThisWorkbook.Sheets
    If oSheet.Name <> sNameSheet Then
        oSheet.Paste
    End If
Next oSheet
End Sub

Douraka outchit, chto mièrvavo litchit .
Messages postés
6786
Date d'inscription
vendredi 16 décembre 2005
Statut
Membre
Dernière intervention
21 décembre 2011
18
Pas chez moi, mais ça dépends certainement de ce que tu as dans tes données, où la façon dont est agencé tes cellules.
Au cas où, change Paste par PasteSpecial mais j'y crois pas trop

@++

le mystérieux chevalier,"Provençal, le gaulois"
Forum Office & VBA
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
Salut,

autre solution plus simple qui repond a tes 2 souhaits
copie apres la feuille existante et creation de 6 copies de la feuille existante

Sub CopyActiveSheet2OtherSheets()
    Dim i as Long
    Dim sNameSheet As String

    sNameSheet = "Sheet1"
    For i = 1 to 6
        Worksheets(sNameSheet).Copy after:=Worksheets(Sheets.Count)
    Next i
End if

A+
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010

Salut Bigfish, le vrai!

Effectivement, c'est exactement ce à quoi je m'attendais...'excepté End Sub et non End if"
Aurais-tu la suite pour renommer les 6 nouvelles fiches dans un ordre bien précis.
Avec ta formule je ne peux plus utiliser Sheets.Add.Name = "Divers2", mais surtout, je ne sais pas ou la placer dans ta formule!

Merci encore à vous deux

Douraka outchit, chto mièrvavo litchit .
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010

Merci bigfish,

On y est presque...
Je te promets de ne pas le faire exprès, mais j'avais mis divers1, divers 2 à titre informel (je garde ton option en mémoire, car elle en résoud 99% et pourra me servir pour autre chose, d'ailleurs c'est le but de ce forum, merci à vous)...

Malheureusement, je complique la tâche avec des noms spécifiques, qui cependant, seront toujours les mêmes!

Je pense pouvoir m'en sortir maintenant que tu m'as fait le plus gros du travail, en plaçant à la fin de ton dernier programme:WorkSheets("Divers1").Name = "Bill"
WorkSheets("Divers2").Name = "Coup"
WorkSheets("Divers3").Name = "Pay"
WorkSheets("Divers4").Name = "Spec"
WorkSheets("Divers5").Name = "Tax"
WorkSheets("Divers6").Name = "Income"

Mais si tu as une solution moins fastidieuse... d'avance merci.

Merci pour l'Application.ScreenUpdating = False (and True), je connaissais déjà le truc mais je ne savais pas qu'il fallait remettre True!!!
:-)

Douraka outchit, chto mièrvavo litchit .
Messages postés
1835
Date d'inscription
vendredi 13 mai 2005
Statut
Membre
Dernière intervention
20 novembre 2013
9
...

Sub CopyActiveSheet2OtherSheets()
    Application.ScreenUpdating = False
    Dim i as Long
    Dim sNameSheet As String, NewSheetName As String, ListSheetName As String
    ListSheetName = "Bill*Coup*Pay*Spec*Tax*Income" 'ici j'utilise un separateur * pour une meilleur lisibilité mais une virgule aurait tres bien fait l'affaire
    sNameSheet = "Sheet1"
    For i = 1 to 6
        Worksheets(sNameSheet).Copy after:=Worksheets(Sheets.Count)
        'on recupere le nom avant le premier separateur "*"
        'la fonction instr va nous renvoyer la position du premier separateur a partir de la gauche
        'la fonction left recupere le nombre de caractere specié (ici via la fonction instr) a partir de la gauche
        NewSheetName = Left(ListSheetName, Instr(1, ListSheetName, "*") - 1)  '-1 pour ne pas prendre l'*

        Worksheets.Item(Sheets.Count).Name = NewSheetName
       'on enleve de la liste le nom deja utilisé

        ListSheetName = Right(ListSheetName, Len(NewSheetName) + 1) '+1 pour enlever aussi l'*
    Next i
    Application.ScreenUpdating = True
End sub

j'ai pas testé mais cela devrait marché

A+
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010

Bonsoir Bigfish,

Je te donnerai la réponse Mardi "au boulot".

En attendant merci pour le partage de ton savoir et notamment les explications "en vert" qui me permettent de comprendre ce que fait chacune des applications.
Bon Week-end




Douraka outchit, chto mièrvavo litchit .
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010

Salut Bigfish,

Décidemment, je deviens un morduš!

Concernant ta dernière modification, la macro s'arrête aprés avoir créé l'onglet Bill, elle en a créée un deuxième, mais pas le suivant de la liste mais : "Sheet1(2)" pour ce qui est de l'instruction sur ton Sub (voir en rouge ci-dessous):

Sub CopyActiveSheet2OtherSheets()
    Application.ScreenUpdating = False
    Dim i as Long
    Dim sNameSheet As String, NewSheetName As String, ListSheetName As String
    ListSheetName = "Bill*Coup*Pay*Spec*Tax*Income" 'ici j'utilise un separateur * pour une meilleur lisibilité mais une virgule aurait tres bien fait l'affaire
    sNameSheet = "Sheet1"
    For i = 1 to 6
        Worksheets(sNameSheet).Copy after:=Worksheets(Sheets.Count)
        'on recupere le nom avant le premier separateur "*"
        'la fonction instr va nous renvoyer la position du premier separateur a partir de la gauche
        'la fonction left recupere le nombre de caractere specié (ici via la fonction instr) a partir de la gauche
       NewSheetName = Left(ListSheetName, Instr(1, ListSheetName, "*") - 1)  '-1 pour ne pas prendre l'*
        Worksheets.Item(Sheets.Count).Name = NewSheetName
       'on enleve de la liste le nom deja utilisé
        ListSheetName = Right(ListSheetName, Len(NewSheetName) + 1) '+1 pour enlever aussi l'*
    Next i
    Application.ScreenUpdating = True
End sub

Quand je reste sur l'application ListSheetName, le message est :
ListSheetName = "ncome", ne faudrait-il pas que ce soit
ListSheetName ="Bill*Coup*Pay*Spec*Tax*Income" ?????

Merci en tout cas...

@+

Douraka outchit, chto mièrvavo litchit .
Messages postés
57
Date d'inscription
vendredi 13 juin 2008
Statut
Membre
Dernière intervention
26 mai 2010

Salut Bigfish, le vrai!


Effectivement cette fois ci, c'est bon!


Merci mille fois pour le temps passé et à bientôt pour de nouvelles aventures!




Douraka outchit, chto mièrvavo litchit .