Transposer selon N° de Folio en colonne A sur 4 colonnes

Bonjour à toutes et tous

Petite pane en VBA

Le but est de faire une liste d'étiquettes en 4 rangées pour alimenter l'imprimante

J'arrive à extraire les données les unes derrière les autres, mais l'idéal serait:

Mettre les repères de la colonne B en colonnes C-D-E-F par folio.

A chaque changement de folio, sauter 1 ligne

Exemple en fichier joint avec la première étiquette en colonne C de la série avec le N° de folio

Merci pour votre précieuse aide

Bonjour boby71C,

Une solution avec le code suivant, si j'ai bien compris.

Sub MiseEnFormeEtiquette()
    Dim tablo, temp
    Dim i As Long, j&, deb&, lim&, lign&, taille&

    Application.ScreenUpdating = False
    tablo = Range("a1:b" & Range("a" & Rows.Count).End(xlUp).Row + 1).Value
    deb = i + 1: i = deb: lign = 1: lim = UBound(tablo)

    Do While i < lim
        Do While tablo(i, 1) = tablo(i + 1, 1): i = i + 1: Loop    'boucle qui cherche le prochain folio
        taille = (Int((i - deb + 1) / 4) + 1)
        ReDim temp(1 To taille, 1 To 4)
        temp(1, 1) = tablo(deb, 1)
        For j = deb + 1 To i + 1
            temp((j - deb) \ 4 + 1, j + 1 - deb - ((j - deb) \ 4) * 4) = tablo(j - 1, 2)
        Next j
        With Cells(lign, 7)    'met les valeurs en colonne 7
            .Font.Bold = True    'met en gras
            .Interior.Color = vbYellow    'met en jaune
            .Resize(taille, 4).Value = temp
        End With
        lign = lign + taille
        deb = i + 1
        i = deb
    Loop
End Sub

Bonsoir vba-new et le forum

J'ai trouvé un Dieu du VBA

Ca à l'ai de très bien fonctionner comme je le désirais. C'est merveilleux. Je prendrais plus de temps pour contrôler si tous les repères sont bien là mais j'ai l'impression qu'au premier coup d'oeil, c'est correct.

Je suis en congés depuis ce soir, mais je prendrais tout de même le temps de regarder plus en détail, ne serait ce que pour comprendre le code. Je crée quelques codes, mais si pointus, je n'en suis pas capable

Chose que j'ai oublié de préciser, c'est que à chaque changement de folio, sauter une ligne d'étiquettes

Si je n'abuse pas trop de votre temps, pour ne pas mourir bête, pourriez vous me commenter le code que je ne comprends pas totalement ?

Merci

Très bon Week-end à tous

Robert de la Saône et Loire, à coté de Chalon sur Saône, car excusez moi, mais j'avais oublié de me présenter.

Boby71C a écrit :

Chose que j'ai oublié de préciser, c'est que à chaque changement de folio, sauter une ligne d'étiquettes

Boby71C a écrit :

Si je n'abuse pas trop de votre temps, pour ne pas mourir bête, pourriez vous me commenter le code que je ne comprends pas totalement ?

Sub MiseEnFormeEtiquette()
    Dim tablo, temp
    Dim i As Long, j&, deb&, lim&, lign&, taille&

    Application.ScreenUpdating = False    'désactive la mise à jour de l'écran

    'on met dans une variable la plage de cellule car le traitement
    'd'un tableau intermédiaire est plus rapide que la manipulation directe des cellules
    tablo = Range("a1:b" & Range("a" & Rows.Count).End(xlUp).Row + 1).Value

    deb = i + 1
    i = deb
    lign = 1
    lim = UBound(tablo)    'limite du tableau

    Do While i < lim
        Do While tablo(i, 1) = tablo(i + 1, 1): i = i + 1: Loop    'boucle qui cherche le prochain folio
        taille = (Int((i - deb + 1) / 4) + 1)    'détermine le nb de ligne de chaque folio sachant qu'il y a 4 colonnes
        ReDim temp(1 To taille, 1 To 4)
        temp(1, 1) = tablo(deb, 1)    'met le nom du folio au début du tableau
        For j = deb + 1 To i + 1

            'cette partie est difficile à expliquer !
            'juste une remarque : l'antislash "\" est différent du signe "/" (slash)
            'le "\" donne la partie entière d'une division
            temp((j - deb) \ 4 + 1, j + 1 - deb - ((j - deb) \ 4) * 4) = tablo(j - 1, 2)
        Next j
        With Cells(lign, 7)    'met les valeurs en colonne 7
            .Font.Bold = True    'met en gras
            .Interior.Color = vbYellow    'met en jaune
            'redimensionnement de la plage de cellule pour accueillir le tableau (même nb de ligne et colonne)
            .Resize(taille, 4).Value = temp
        End With

        'en rajoutant le +1 tu sautes une ligne d'étiquettes
        'la variable lign détermine l'endroit où on va copier le tableau à chaque changement de folio
        lign = lign + taille + 1

        deb = i + 1    'ligne du prochain folio
        i = deb
    Loop
End Sub

Je n'ai pas expliqué l'algorithme utilisé qui permet de passer de 2 colonnes à 4 colonnes en oubliant pas le nom du folio car c'est ce que j'appelle un algorithme bricolé !! Ça part d'une logique, mais je sais que ça marche qu'après avoir fait moult tests

Bonjour à tous

Merci beaucoup vba-new

D'ici quelques temps, je vais avoir un sujet beaucoup plus complexe à faire que je suis incapable de créer. J'ai donc demandé un chiffrage à notre service informatique (sous_traitance)

@+

Robert