création et tri d'onglets avec des noms numéric

[papapaul]

Bonjour Forum,
J'essaye d'adapter un truc qui marche parfaitement bien.
Vous l'avez forcément déja vu.
Avec la Macro1, je choisis une colonne (A,B...) de la Feuil1.
Ca permet de crée autant d'onglets que d'items différents de cette
colonne en y copiant les lignes correspondantes.
Si les onglets existent déja, ils sont "écrasés".

J'ai un problème de tri et isnumeric à la création des onglets.
Je sais faire ca dans une listbox (merci Pierrejean)
mais ici dans mon exemple avec la colonne D pour créer 4 onglets
taux de remise (5,10,15,20) c'est la pagaille.
Avez vous une idée ?
Merci d'avance à ceux qui auront le temps et le savoir
Bonne journée à tous.

 

[Spitnolan08]

Re : création et tri d'onglets avec des noms numéric

Bonjour Papapaul,

Il serait préférable que tu fasse le tri des doublons dans ta collection entetecol. Ensuite tu n'aurais plus de souci dans la création des onglets.

Il faut donc placer un test pour savoir si la nouvelle valeur est déjà contenue dans la collection. Si oui ne pas l'ajouter.

Cordialement

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Merci Spitnolan, forum
Je crois que tu veux dire que dans cette partie de code
qu'il faudrait modifier quelquechose ?

Dim entetecol As Collection
Set entetecol = New Collection
colref = InputBox("Précisez la colonne de référence, (A,B,...) pour la création des onglets")
For n = 2 To Range("A65536").End(xlUp).Row
On Error Resume Next
entetecol.Add Range(colref & n)
On Error GoTo 0
Next n
For n = 1 To entetecol.Count
For m = 1 To Sheets.Count
If Sheets(m).Name = entetecol(n) Then
exist = True
Exit For
End If
Next m
If Not exist Then
Sheets.Add.Name = entetecol(n)
Sheets("Feuil1").Range("A1:F1").Copy Destination:=ActiveSheet.Range("A1")
End If
exist = False
Next n

J'ai essayé en ajoutant des méthodes de tris d'entetecol
mais le mieux que je suis arrivé, c'est à isoler les
5,10,15 et 20 sur chacun une feuille mais pas avec les
bons noms de feuilles et en plus mal rangées.

Je m'en sors pas. Je continue à chercher mais
Un coup de main serait bien venu.
Merci à tous.

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Re Spitnolan, le Forum
J'avance mais pas vite :
J'ai retrouvé dans mes archives une macro qui fait bien
ce que je veux. Creation des onglets et copie des lignes.
Contrairement à mon exemple précédent ca marche bien même avec la D.
Reste juste le problème que ca me trie les onglets
10,15,20,5 au lieu de 5,10,15,20 (probleme de conversion des noms d'onglets s'ils sont numeric ?)
Faudrait modifier le code ci-dessous que j'ai mis en fin de procédure.
Dim X As Variant
Dim I As Variant
For Each X In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
If Sheets(I - 1).Name > Sheets(I).Name Then
Sheets(I - 1).Move After:=Sheets(I)
End If
Next
Next
Pas très grave mais ca m'agace de pas y arriver tout seul.

Bonne soirée les forumeurs

 

[Spitnolan08]

Re : création et tri d'onglets avec des noms numéric

Re,

Je n'ai pas regardé ton dernier post mais tu as une solution ci après (Peut être pas optimisée):

Sub entete()
Dim entetecol() As Variant
colref = InputBox("Précisez la colonne de référence, (A,B,...) pour la création des onglets")
For n = 2 To Range("A65536").End(xlUp).Row
    ReDim Preserve entetecol(n - 1)
    If n = 2 Then entetecol(0) = Range(colref & n).Value: n = n + 1
    For j = 0 To UBound(entetecol)
        If Range(colref & n).Value = entetecol(j) Then GoTo 1
    Next
    entetecol(n - 2) = Range(colref & n).Value: n = n + 1
1 Next n

For n = 0 To UBound(entetecol)
    For m = 1 To Sheets.Count
        If Sheets(m).Name = entetecol(n) Then
        exist = True
        Exit For
        End If
    Next m
    
    If Not exist Then
        Sheets.Add.Name = entetecol(n)
        Sheets("Feuil1").Range("A1:F1").Copy Destination:=ActiveSheet.Range("A1")
    End If
    exist = False
Next n

For L = 0 To UBound(entetecol, 1)
    For L2 = 0 To UBound(entetecol, 1)
        If entetecol(L) < entetecol(L2) Then
            tmp = entetecol(L2): entetecol(L2) = entetecol(L): entetecol(L) = tmp
            Sheets(CStr(entetecol(L))).Move after:=Sheets(CStr(entetecol(L2)))
        End If
    Next
Next

End Sub

Cordialement

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Bonjour Forum, Spitnolan
Merci d'essayer de me dépanner, j'ai essayé
mais y a une erreur 1004 avec le code ci-dessous
Sheets.Add.Name = entetecol(n)
J'ai essayé de mettre on error resume next juste avant
mais ca ne va pas.
J'ai alors repris ma dernière version ci-dessus qui fait bien le tri
des onglets sauf avec la colonne D , en mettant ta méthode à la place :
Dim entetecol() As Variant
For L = 0 To UBound(entetecol, 1)
For L2 = 0 To UBound(entetecol, 1)
If entetecol(L) < entetecol(L2) Then
tmp = entetecol(L2): entetecol(L2) = entetecol(L): entetecol(L) = tmp
Sheets(CStr(entetecol(L))).Move after:=Sheets(CStr(entetecol(L2)))
End If
Next
Next
Désolé mais ca ne marche pas bien.
Je continue à chercher. Merci à toi.
Bonne journée à tous.

 

[Spitnolan08]

Re : création et tri d'onglets avec des noms numéric

Re,

mais y a une erreur 1004 avec le code ci-dessous

Chez moi tout fonctionne...


Cordialement

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Re Forum, Spit : chez moi ca marche pas
Alors j'ai bricolé un truc en ajoutant 2 tris :
1 de la colonne choisie au début et 1 autre
à la fin pour remettre le tri de départ qui est colonne A.
J'ai pas tout bien compris comment ca marche notamment
pourquoi cette ligne la :
Range("A" & j & ":" & "B" & j & ":" & "X" & j).Select
que j'arrive pas à remplacer par
Range("IV1").end(xltoleft).select

Tanpis, c'est pas jojo tout ca mais apparement ca fonctionne bien
sauf avec la colonne F

Ceux qui voudront bien regarder seront sympas
de me dire ce que je pourrais améliorer.

Merci XLD

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Oups, j'ai encore été trop vite.
Remplacer : Range("A" & j & ":" & "B" & j & ":" & "X" & j).Select
par : Range("IV1").End(xlToLeft).Select
C'est OK, j'avais un . de trop.
Reste donc que le pourquoi ca marche pas avec la colonne F.
Milles excuses

 

[pierrejean]

Re : création et tri d'onglets avec des noms numéric

bonjour papapaul

Salut à tous

de l'utilisation du Cstr !!

je n'ais rajouté a la version d'origine que 2 Cstr( )

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Bonsoir Pierrejean, Forum
Merci beaucoup, ca marche effectivement bien
avec la colonne F, mais du coup, l'infame bricolage
que j'ai inventé pour trier les onglets si les noms sont des chiffres
ne fonctionne plus.
C'est pour fignoler mais j'aimerais bien que ca donne
un classement 5,10,15,20 si colonne D
4.18, 18.70, 31.34...si colonne F
J'ai bien du mal à comprendre pourquoi ca marche bien
avec la colonne A (chiffres) et pas avec D,E et F
Je patauge.

Bonsoir à tous

 

[JYLL]

Re : création et tri d'onglets avec des noms numéric

Bonsoir Papapaul et le Forum,

Salut Spitnolan, PierreJean

Ton problème vient tout simplement que ta feuille nommée"" tu dois la nommer "05" et la tu verras tout se passera normalement. Excel prenant le code ASCII des caractères pour leurs donner le rang de "10" est 49 pour le "1" et celui de "20" est 50 pour le 2 et celui de "5" est 53 d'où son rang plus élévé.

Je fais route sur la normandie lundi pour 3 ou 4 jours, enfin le Plateau.

Bon test et à bientôt.

 

[gbinforme]

Re : création et tri d'onglets avec des noms numéric

Bonsoir à tous,

Pour résoudre ton souci, je te propose de changer cette partie de code :

Dim W1 As Variant
Dim W2 As Variant
For Each X In ActiveWorkbook.Sheets
For I = 2 To ActiveWorkbook.Sheets.Count
W1 = Sheets(I - 1).Name
W2 = Sheets(I).Name
If IsNumeric(W1) Then W1 = Val(W1)
If IsNumeric(W2) Then W2 = Val(W2)
If W1 > W2 Then
Sheets(I - 1).Move After:=Sheets(I)
End If

 

[papapaul]

Re : création et tri d'onglets avec des noms numéric

Re Forum, Pierrejean, gbinforme, JYll
Merci gbinform, malgré toutes mes recherches je
n'ai jamais vu ce genre de code
If IsNumeric(W1) Then W1 = Val(W1)
Merci Pierrejean pour cstrl, j'arrive jamais bien à l'utiliser.
Comme CDbl d'ailleurs, que veux tu je suis pas doué.
En tout cas les deux marchent
Merci JYLL, ca à l'air simple pour toi, mais moi ASCII,
j'y connais que couic.
Je vais étudier ca demain, en tout cas bonne route
et bienvenu du côté des Grands Bureaux
il va faire beau !!
Vive XLD