Dispatcher des numéros 3 par 3

[criscris11]

Bonjour à tous,
Je cherche un moyen simple et rapide de dispatcher des numéros 3 par 3 dans un modèle d'onglet.
J'ai tout expliqué dans le fichier-joint.
Merci d'avance à tous et bon week-end.

 

[pierrejean]

Re : Dispatcher des numéros 3 par 3

bonjour ami cricris

Vois si cela te convient

 

[Hulk]

Re : Dispatcher des numéros 3 par 3

Hello Forum, Criscris, ami Pierrejean,

Me permets juste d'apporter une toute petite modif à ta chouette petite macro Pierrejean... tu comprendras j'espère

Remplacer cette ligne

  Sheets.Add.Name = Sheets("TEST").Name & " " & Sheets("TEST").Range("A1") & " plage " & num

par

  ActiveWorkbook.Sheets.Add after:=Worksheets(Worksheets.Count)
  ActiveSheet.Name = Sheets("TEST").Name & " " & Sheets("TEST").Range("A1") & " plage " & num

Pour ceux qui ne savent pas, il s'agit de mettre en ordre les feuilles rajoutées.

Bien sûr après l'ami Criscris peut encore rajouter en fin de procédure Sheets("TEST BLANC plage 1").Select s'il veut.

Bon we à vous !

Cdt, Hulk.

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re le fil,
Merci Pierrejean pour ce code qui me convient parfaitement .
Merci à Hulk pour sa petite touche personnelle très pratique.

Pour finaliser, y a t'il un moyen via un clic sur un des numéros dans la feuille TEST, de pointer sur la page qui a été créée et qui contient ce numéro ?
Merci encore à tous les deux et d'avance pour la suite.
Bon après-midi.

 

[Hulk]

Re : Dispatcher des numéros 3 par 3

Re,

Il y a bien ceci qui normalement devrait jouer, mais il y a quatre petites erreurs que je ne parviens pas à corriger.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim x As Variant
    On Error Resume Next
    
    If Not Application.Intersect(Target, Range("A2:A42")) Is Nothing Then
        For Each Wb In Application.Workbooks
            For Each Ws In Wb.Worksheets
                For Each x In ThisWorkbook
                    Set x = Ws.Cells.Find(Target)
                        If Not x Is Nothing Then
                            Ws.Select
                            x.Select
                        End If
                Next x
            Next Ws
        Next Wb
    End If

End Sub

J'avoue ne pas comprendre pourquoi ces erreurs

Click sur A1, il va chercher A19 en page 7
Click sur A2, il va chercher A28 en page 10
Click sur A3, il va chercher A37 en page 13
Click sur A4, il va chercher A40 en page 14

Le reste c'est bon

Si un génie améliore ce code...

Hulk.

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re,
Merci pour ton code Hulk. On va attendre le retour de Pierrejean qui saura certainement pallier à ces erreurs car n'étant un spécialiste du VBA...

Je voudrais revenir sur le fichier en lui-même.
Dans un classeur, j'ai des numéros dans 4 colonnes différentes. Si je change le code pour chaque colonne, est ce que le code créera les feuilles de la même façon à la suite des autres ? Ou faut il modifier le code ?
Si cela n'est trop clair, fais le moi savoir et je posterai un exemple.
Merci encore et bon après-midi.

 

[Hulk]

Re : Dispatcher des numéros 3 par 3

Re,

Le mieux est que tu bricoles, adaptes, modifies à ta guise, même étant novice.
Essaye tout ce que tu peux, tu verras un petit peu ce que ça fait.

Moi mon niveau n'est certainement pas plus haut que le tien, mais c'est comme ça que j'ai commencé et arrivé où j'en suis aujourd'hui

Concernant le dernier code, je continuerai mes petites recherches ce soir, là je vais profiter su soleil

Cdt, Hulk.

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re,
Ok Hulk, je vais faire des tests pour voir ce que çà donne et profite bien du soleil .

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re,
Pendant que tu profites du soleil, j'ai fait des tests en recopiant la macro et en changeant les données à prendre en compte et les nouveaux onglets se créent bien et au bon endroit : que du bonheur.
Reste la petite recherche qui pointe sur la feuille quand on clique sur le n° et à ce sujet est ce que

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

peut gérer plusieurs plages ?

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re à tous,
J'en profite de faire remonter ce fil car j'ai vu trainer sur le forum de grands VBAistes : je ne citerai pas de nom alors j'espère qu'ils se reconnaîtront .
Bonne journée à tous.

 

[pierrejean]

Re : Dispatcher des numéros 3 par 3

Re

A signaler: Je laisse souvent mon ordinateur sur XLD même si je vaque aux emplois domestiques !!

Comme je ne sais pas ou tu en es de ton fichier je ne donne que la macro a mettre dans le module de la feuille "TEST"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
num = Int((Target.Row + 1) / 3)
If Target.Column = 1 And Target.Row >= 2 And Target.Row <= Cells(65536, 1).End(xlUp).Row Then
  feuille = ActiveSheet.Name & " " & ActiveSheet.Range("A1") & " plage " & num
  Set c = Sheets(feuille).Columns(2).Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
  If Not c Is Nothing Then
    Sheets(feuille).Select
    c.Select
  End If
End If
End Sub

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re,
Merci Pierrejean mais j'ai un erreur d'exécution 9 : L'indice n'appartient pas à la sélection.
Je poste le fichier sur lequel il est destiné.
Merci d'avance.

 

[pierrejean]

Re : Dispatcher des numéros 3 par 3

Re

Eh oui !

Je m'etais planté en creant des feuilles avec plage 1
tu as rectifié ce qui est tres bien mais je continuais dans l'erreur
Vois si cela va mieux

 

[criscris11]

Re : Dispatcher des numéros 3 par 3

Re,
Autant pour moi Pierrejean, j'avais oublié de te le préciser.
Comme expliqué un peu plus haut, dans un fichier identique je me retrouve avec 4 colonnes de numéros car même article (TEST) mais plusieurs catégories (BLANC, VERT, ROUGE, BLEU).
D'où ma question, est ce que ta macro peut gérer les 4 colonnes de numéros ?
Si est la réponse est non, peut on envisager une recherche du numéro via un USF ?
Dans l'attente de tes conseils, je te remercie encore une fois et te souhaite un bon après-midi.

PS : j'ai oublié l'essentiel : oui cela marche très bien comme cela. Merci encore.

 

[kjin]

Re : Dispatcher des numéros 3 par 3

Bonjour,
Histoire de ne pas trop bronzer
Peut-être une autre solution

Sub Test()
Application.ScreenUpdating = False
num = 1
Col = CInt(InputBox("entre le numéo de la colonne (1, 3, 5 ou 7)"))
If Not IsNumeric(Col) Or Col = "" Then Exit Sub
With Sheets("Test")
    Feuille = .Cells(1, Col).Value
    For n = 2 To .Cells(1, Col + 1).Value Step 3
    Sheets("Feuille de MAT vierge").Copy after:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = Feuille & " page " & num
            Lien = .Name
            .Range("B8") = Sheets("TEST").Cells(n, Col)
            .Range("B20") = Sheets("TEST").Cells(n + 1, Col)
            .Range("B31") = Sheets("TEST").Cells(n + 2, Col)
        End With
    .Hyperlinks.Add Anchor:=.Cells(n, Col), Address:="", SubAddress:= _
    "'" & Lien & "'!B8", TextToDisplay:=.Cells(n, Col).Text
    .Hyperlinks.Add Anchor:=.Cells(n + 1, Col), Address:="", SubAddress:= _
    "'" & Lien & "'!B20", TextToDisplay:=.Cells(n + 1, Col).Text
    .Hyperlinks.Add Anchor:=.Cells(n + 2, Col), Address:="", SubAddress:= _
    "'" & Lien & "'!B31", TextToDisplay:=.Cells(n + 2, Col).Text
    num = num + 1
    Next n
End With
Application.ScreenUpdating = True

End Sub

Il faudrait rajouter les divers contrôles d'erreurs (feuille existante, num col...) mais je ne veux pas rester blanc non plus
A+
kjin