Code VBA en erreur pour création d'onglets selon critères

  • Initiateur de la discussion Initiateur de la discussion LPandre
  • Date de début Date de début

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 !

LPandre

XLDnaute Impliqué
Bonjour,
je souhaite créer un onglet par valeur de la colonne A (avec les titres et les données qui vont avec bien sur).
J'ai récupéré sur le forum du code, mais j'ai un message " Cette clé est déjà associée à un élément de la collection".
Je ne pas comprends pourquoi ça coince.

Si quelqu'un(e) à la solution... Merci à elle/lui par avance.

Le code récupéré (je ne le mets pas dans le fichier joint pour éviter des messages liés à la sécurité des macros) :
Sub recopie()
Dim coll As Collection
Set coll = New Collection
For n = 2 To Range("A65536").End(xlUp).Row
On Error Resume Next
coll.Add Range("A" & n), CStr(Range("A" & n))
On Error GoTo 0
Next n
For n = 1 To coll.Count
ligne = 2
Sheets.Add.Name = coll(n)
Sheets("SOURCE").Rows(1).Copy Destination:=ActiveSheet.Rows(1)
For m = 2 To Sheets("Source").Range("A65536").End(xlUp).Row
If Sheets("SOURCE").Range("A" & m) = coll(n) Then
Sheets("SOURCE").Rows(m).Copy Destination:=ActiveSheet.Rows(ligne)
ligne = ligne + 1
End If
Next m
Next n
End Sub
 

Pièces jointes

Re : Code VBA en erreur pour création d'onglets selon critères

bonjour Lpandre
de mon côté le code est bon
essaye avec ce code
dans menu outils,références microsoft scripting runtime doit être coché
Code:
Sub recopie()
Dim d As New Dictionary

For n = 2 To Range("A65536").End(xlUp).Row
d(Range("A" & n).Value) = Range("A" & n).Value
Next n
For Each Item In d.Items
ligne = 2
Sheets.Add.Name = Item
Sheets("SOURCE").Rows(1).Copy Destination:=ActiveSheet.Rows(1)
For m = 2 To Sheets("Source").Range("A65536").End(xlUp).Row
If Sheets("SOURCE").Range("A" & m) = Item Then
Sheets("SOURCE").Rows(m).Copy Destination:=ActiveSheet.Rows(ligne)
ligne = ligne + 1
End If
Next m
Next Item
 
- 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
909
  • Question Question
Microsoft 365 worksheet_change
Réponses
29
Affichages
1 K
Réponses
15
Affichages
779
Retour