Petit Soucil de division de feuille

J

JeanMikael

XLDnaute Junior
Re-re Bonjour le forum,


J'ai cette macro :


Code: 
Sub distribue4()
Dim n As Integer
Dim ftr As String
'declaration de collection
Dim criteres As Collection
Set criteres = New Collection
'creation de la collection des criteres
Application.ScreenUpdating = False

For n = 2 To Range("g65536").End(xlUp).Row
  On Error Resume Next
    criteres.Add Range("g" & n), CStr(Range("g" & n))
  On Error GoTo 0
Next n

'ajout d'une feuille par critere
For n = 1 To criteres.Count

  Sheets.Add.Name = "Erreur " & criteres(n)

  Sheets("Feuil1").Range("A1:AD1").Copy Destination:=ActiveSheet.Range("A1")

Next n

'tansfert vers les feuilles
For n = 2 To Sheets("Feuil1").Range("g65536").End(xlUp).Row

  ftr = "Erreur " & Sheets("Feuil1").Range("g" & n)
 
  Sheets("Feuil1").Range("A" & n & ":AD" & n).Copy Destination:=Sheets(ftr).Range("A65536").End(xlUp).Offset(1, 0)

Sheets("Feuil1").Select

Next n

Application.ScreenUpdating = True

End Sub

Cette macro me permet de créer un onglet pour chaque valeur rencontrer dans la colonne G, dans cette colonne ce sont des chiffre jusque là tout va bien, mon soucil c'est que dans ma colonne j'ai par exemple des chiffre de 0 à 9 donc mon code va crée un onglet nommé Erreur 1 par exemple et ce que je souhaiterai c'est ajouter un 0 pour les onglet qui vont de Erreur 1 à 9 donc j'aurai par exemple comme nom d'onglet Erreur 01, j'ai essayé de mettre dans ma colonne G un format personnalisée qui met un 0 devant les chiffres allant de 1 à 9 met la macro lorsqu'elle divise les onglets ne tient pas compte du format personalisée, comment faire pour obtenir le résultat souhaité ?
d'avance merci de votre aide, bonne après-midi.

Cordialement,
Jean-Mikaël
 
Trier par date Trier par votes
J

JeanMikael

XLDnaute Junior
Re : Division d'Onglet

Re-re Bonjour le forum,


J'ai cette macro :



Code: 
Sub distribue4()
Dim n As Integer
Dim ftr As String
'declaration de collection
Dim criteres As Collection
Set criteres = New Collection
'creation de la collection des criteres
Application.ScreenUpdating = False

For n = 2 To Range("g65536").End(xlUp).Row
  On Error Resume Next
    criteres.Add Range("g" & n), CStr(Range("g" & n))
  On Error GoTo 0
Next n

'ajout d'une feuille par critere
For n = 1 To criteres.Count

  Sheets.Add.Name = "Erreur " & criteres(n)

  Sheets("Feuil1").Range("A1:AD1").Copy Destination:=ActiveSheet.Range("A1")

Next n

'tansfert vers les feuilles
For n = 2 To Sheets("Feuil1").Range("g65536").End(xlUp).Row

  ftr = "Erreur " & Sheets("Feuil1").Range("g" & n)
 
  Sheets("Feuil1").Range("A" & n & ":AD" & n).Copy Destination:=Sheets(ftr).Range("A65536").End(xlUp).Offset(1, 0)

Sheets("Feuil1").Select

Next n

Application.ScreenUpdating = True

End Sub

Cette macro me permet de créer un onglet pour chaque valeur rencontrer dans la colonne G, dans cette colonne ce sont des chiffre jusque là tout va bien, mon soucil c'est que dans ma colonne j'ai par exemple des chiffre de 0 à 9 donc mon code va crée un onglet nommé Erreur 1 par exemple et ce que je souhaiterai c'est ajouter un 0 pour les onglet qui vont de Erreur 1 à 9 donc j'aurai par exemple comme nom d'onglet Erreur 01, j'ai essayé de mettre dans ma colonne G un format personnalisée qui met un 0 devant les chiffres allant de 1 à 9 met la macro lorsqu'elle divise les onglets ne tient pas compte du format personalisée, comment faire pour obtenir le résultat souhaité ?
d'avance merci de votre aide, bonne après-midi.

Cordialement,
Jean-Mikaël
 
Vote positif 0 Vote négatif
Gorfael

Gorfael

XLDnaute Barbatruc
Re : Petit Soucil de division de feuille

JeanMikael à dit:
Re-re Bonjour le forum,


J'ai cette macro :


Code: 
Sub distribue4()
Dim n As Integer
Dim ftr As String
'declaration de collection
Dim criteres As Collection
Set criteres = New Collection
'creation de la collection des criteres
Application.ScreenUpdating = False
 
For n = 2 To Range("g65536").End(xlUp).Row
  On Error Resume Next
    criteres.Add Range("g" & n), CStr(Range("g" & n))
  On Error GoTo 0
Next n
 
'ajout d'une feuille par critere
For n = 1 To criteres.Count
 
  Sheets.Add.Name = "Erreur " & criteres(n)
 
  Sheets("Feuil1").Range("A1:AD1").Copy Destination:=ActiveSheet.Range("A1")
 
Next n
 
'tansfert vers les feuilles
For n = 2 To Sheets("Feuil1").Range("g65536").End(xlUp).Row
 
  ftr = "Erreur " & Sheets("Feuil1").Range("g" & n)
 
  Sheets("Feuil1").Range("A" & n & ":AD" & n).Copy Destination:=Sheets(ftr).Range("A65536").End(xlUp).Offset(1, 0)
 
Sheets("Feuil1").Select
 
Next n
 
Application.ScreenUpdating = True
 
End Sub

Cette macro me permet de créer un onglet pour chaque valeur rencontrer dans la colonne G, dans cette colonne ce sont des chiffre jusque là tout va bien, mon soucil c'est que dans ma colonne j'ai par exemple des chiffre de 0 à 9 donc mon code va crée un onglet nommé Erreur 1 par exemple et ce que je souhaiterai c'est ajouter un 0 pour les onglet qui vont de Erreur 1 à 9 donc j'aurai par exemple comme nom d'onglet Erreur 01, j'ai essayé de mettre dans ma colonne G un format personnalisée qui met un 0 devant les chiffres allant de 1 à 9 met la macro lorsqu'elle divise les onglets ne tient pas compte du format personalisée, comment faire pour obtenir le résultat souhaité ?
d'avance merci de votre aide, bonne après-midi.

Cordialement,
Jean-Mikaël
Cliquez pour agrandir...
Salut
comme j'ai la flemme, j'ai pas tout regarder, juste la description du problème
remplacer :
ftr = "Erreur " & Sheets("Feuil1").Range("g" & n)
par
ftr = "Erreur " & format(Sheets("Feuil1").Range("g" & n);"00")
Juste une question au hazard : si t'as un problème d'erreur Excel en plein milieux de ta macro, comment tu exécute ScreenUpDating = True ?
Mais il n'y a aucun risque d'erreur,... normalement
A+
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Re : Petit Soucil de division de feuille

Re-, JeanMikael, bonjour Gorfael

une autre solution :

Sheets.Add.Name = IIf(Len(criteres(n)) = 1, "Erreur 0" & criteres(n), "Erreur " & criteres(n))

Gorfael,
Il me semble que le ScreenUpdating est remis automatiquement à True lorsqu'on stoppe la macro (par End Sub ou arrêt suite à Bug), mais peut-être me trompais-je?
 
Vote positif 0 Vote négatif
J

JeanMikael

XLDnaute Junior
Re : Petit Soucil de division de feuille

Re, bhbh

La ligne que tu m'a filé à l'air de marcher le seul truc c'est que le programme
s'arrete à cette ligne :

Code: 
Sheets("Feuil1").Range("A" & n & ":AD" & n).Copy Destination:=Sheets(ftr).Range("A65536").End(xlUp).Offset(1, 0)

Cordialement,
Jean-Mikaël
 
Vote positif 0 Vote négatif
J

JeanMikael

XLDnaute Junior
Re : Petit Soucil de division de feuille

Ci-joint le fichier exemple avec la macro d'origine sans les ajout de vos différentes suggestions, merci de ton aide.



Cordialement,
Jean-Mikaël
 

Pièces jointes

  • jeanmikael.xls
    30.5 KB · Affichages: 30
  • jeanmikael.xls
    30.5 KB · Affichages: 39
  • jeanmikael.xls
    30.5 KB · Affichages: 28
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Re : Petit Soucil de division de feuille

Ok, pas besoin de fichier,

remplace par :

ftr = "Erreur " & Sheets("Feuil1").Range("g" & n)
ftr = IIf(Len(ftr) < 9, "Erreur 0" & Sheets("Feuil1").Range("g" & n), "Erreur " & Sheets("Feuil1").Range("g" & n))
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Re : Petit Soucil de division de feuille

Re-,
effectivement, difficile de dépanner si tu n'appliques pas les conseils qu'on te donne...;), et que nous, on essaie avec ce qu'on t'a préconisé...

ton code modifié :

Dim criteres As Collection
Set criteres = New Collection
'creation de la collection des criteres
Application.ScreenUpdating = False
For n = 3 To Range("g65536").End(xlUp).Row
On Error Resume Next
criteres.Add Range("g" & n), CStr(Range("g" & n))
On Error GoTo 0
Next n
'ajout d'une feuille par critere
For n = 1 To criteres.Count
Sheets.Add.Name = IIf(Len(criteres(n)) = 1, "Erreur 0" & criteres(n), "Erreur " & criteres(n))
Sheets("liste").Range("A1:AD1").Copy Destination:=ActiveSheet.Range("A1")
Next n
'tansfert vers les feuilles
For n = 3 To Sheets("liste").Range("g65536").End(xlUp).Row
ftr = "Erreur " & Sheets("liste").Range("g" & n)
ftr = IIf(Len(ftr) < 9, "Erreur 0" & Sheets("liste").Range("g" & n), "Erreur " & Sheets("liste").Range("g" & n))
Sheets("liste").Range("A" & n & ":AD" & n).Copy Destination:=Sheets(ftr).Range("A65536").End(xlUp).Offset(1, 0)
Next n
Application.ScreenUpdating = True
End Sub

Celui là fonctionne, je l'ai testé...
 
Vote positif 0 Vote négatif

Discussions similaires

A
  • Question
XL 2019 Mélange aléatoire colonne A sur colonne G ne fonctionne pas
Réponses
3
Affichages
208
arvin
A
cathodique
  • Résolu(e)
XL 2010 Erreur de compilation - Incompatibilité de type: tableau ou type défini par l'utilisateur
Réponses
3
Affichages
211
cathodique
cathodique
C
  • Résolu(e)
XL 2021 Macro pour mise en page
Réponses
11
Affichages
523
candido57
C
S
  • Résolu(e)
Microsoft 365 Ecrasement d'une ligne si déjà existante
Réponses
2
Affichages
161
sebastien176
S
F
  • Résolu(e)
Microsoft 365 Recherche à partir d'une TextBox
Réponses
4
Affichages
450
Francky79
F
ph.vanne
  • Question
Autres fenêtre "Publication"
Réponses
10
Affichages
430
ph.vanne
ph.vanne
C
  • Résolu(e)
XL 2016 Répartir dans des Groupes d'Effectifs Aléatoires ... mais pas trop
Réponses
2
Affichages
286
crocrocro
C
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
1 K
halecs93
halecs93
lynyrd
  • Question
XL 2019 code pour tous les disques
Réponses
3
Affichages
532
AtTheOne
AtTheOne
M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
351
marie3107
M

Membres actuellement en ligne

10 membres et 83 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 124
Messages
2 116 460
Membres
112 748
dernier inscrit
Pboiusquet