XL 2019 Changement d'affichage horizontal à vertical VBA

[antoine.jllt]

Bonjour,

J'ai crée une macro pour afficher dans une autre feuille les informations en colonne ==> En ligne
En exemple sur la feuille 1 :
1 : 18/03/2022 : 1 4 6 7
2 : 20/03/2022 : 1 5 7 2

pour devenir sur une autre feuille 2 :
1 : 18/03/2022 : 1
1 : 18/03/2022 : 4
1 : 18/03/2022 : 6
1 : 18/03/2022 : 7
2 : ....
.
etc...

Le numéro au début de la ligne est un numéro de commande


J'ai une macro mais le soucis est que quand je la relance, il refait tout de A à Z (j'ai jusquà 200 dates parfois.. donc cela prends 10 ans)

J'aimerais qu'il recommence à partir du dernier numéro de commande saisie dans la feuille 2.

Merci de votre aide 🙂

Antoine

 

[chris]

Bonjour

Plus simple à faire avec PowerQuery (quelques clics) sans code : on actualise selon besoins

 

[job75]

Bonjour antoine.jllt, bienvenue sur XLD, bonjour chris,

Voyez le fichier joint et cette macro dans le code de Feuil2 :

Private Sub Worksheet_Activate()
Dim tablo, ncol%, resu(), i&, j%, n&
tablo = Sheets("Feuil1").[A1].CurrentRegion 'matrice, plus rapide
ncol = UBound(tablo, 2)
If ncol > 2 Then ReDim resu(1 To UBound(tablo) * (ncol - 2), 1 To 3)
For i = 1 To UBound(tablo)
    For j = 3 To ncol
        n = n + 1
        resu(n, 1) = tablo(i, 1)
        resu(n, 2) = tablo(i, 2)
        resu(n, 3) = tablo(i, j)
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] '1ère cellule de destination
    If n Then .Resize(n, 3) = resu
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 3).ClearContents 'RAZ en dessous
End With
End Sub

Elle est très rapide car elle utilise des tableaux VBA.

Un tableau de 200 dates c'est vraiment peanuts.

A+

 

[antoine.jllt]

Quelle rapidité! super merci beaucoup pour ton aide!

Cependant je n'arrive pas à le transposer à mon sujet ...

Je te laisse la pièce jointe, si jamais quelqu'un aurait la sympathie de m'aider 🙂

L'objectif est de transférer de la liste1 vers la Liste2 avec la même logique.. (les références et qty en ligne plutôt qu'en colonne)

Merci par avance!

 

[chris]

Bonjour

Une solution PowerQuery

J'ai gardé les X en quantité ne sachant s'ils sont utiles.

Si la source évolue, clic droit dans la liste2, Actualiser

 

[antoine.jllt]

Bonjour

Une solution PowerQuery

J'ai gardé les X en quantité ne sachant s'ils sont utiles.

Si la source évolue, clic droit dans la liste2, Actualiser

Merci beaucoup pour ton aide,

J'aimerais plutot une solution VBA pour la modifier et comprendre..

PowerQuery a planté l'ordinateur...

Merci par avance

 

[chris]

RE

PowerQuery étant intégré à 2019, je ne vois pas pas comment cela peut le planter.

Peut-être la liaison avec le fichier externe qu'il y a dans ton fichier...

Comprendre les 3 ou 4 manips faites avec PowerQuery te poserait moins de difficulté que VBA puisque tu n'a pas su adapter le code de job75...

Si tu ne souhaites pas évoluer en utilisant les facilités de ta version, je laisse la main à job75 🤝


EDIT : testé depuis le fichier ici posté sur un vieux PC équipé de la version 2019. Pas de plantage

 

[job75]

Bonjour antoine.jllt, chris, le forum,

La nouvelle macro adaptée au fichier du post #4 :

Private Sub Worksheet_Activate()
Dim nlig&, tablo, ncol%, resu(), i&, j%, n&, k%
With Sheets("LISTE")
    nlig = Application.Count(.[A:A])
    If nlig = 0 Then GoTo 1 'si le tableau est vide
    tablo = .Range("A5:AD" & nlig + 4)
End With
ncol = UBound(tablo, 2)
If ncol > 10 Then ReDim resu(1 To nlig * (ncol - 10) \ 2, 1 To 12)
For i = 1 To nlig
    For j = 11 To ncol Step 2
        n = n + 1
        resu(n, 11) = tablo(i, j)
        resu(n, 12) = tablo(i, j + 1)
        For k = 1 To 10
            resu(n, k) = tablo(i, k)
Next k, j, i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination
    If n Then
        .Resize(n, 12) = resu
        .Resize(n, 12).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 12).Delete xlUp 'RAZ en dessous
End With
End Sub

Elle se déclenche quand on active la feuille "LISTE2".

A+

 

[job75]

Dans ce fichier ( 2 bis) les lignes sont créées uniquement quand les colonnes Composant ne sont pas vides :

Private Sub Worksheet_Activate()
Dim nlig&, tablo, ncol%, resu(), i&, j%, n&, k%
With Sheets("LISTE")
    nlig = Application.Count(.[A:A])
    If nlig = 0 Then GoTo 1 'si le tableau est vide
    tablo = .Range("A5:AD" & nlig + 4)
End With
ncol = UBound(tablo, 2)
If ncol > 10 Then ReDim resu(1 To nlig * (ncol - 10) \ 2, 1 To 12)
For i = 1 To nlig
    For j = 11 To ncol Step 2
        If tablo(i, j) <> "" Then 'colonnes Composant non vides
            n = n + 1
            resu(n, 11) = tablo(i, j)
            resu(n, 12) = tablo(i, j + 1)
            For k = 1 To 10
                resu(n, k) = tablo(i, k)
            Next k
        End If
Next j, i
'---restitution---
1 If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A2] '1ère cellule de destination
    If n Then
        .Resize(n, 12) = resu
        .Resize(n, 12).Borders.Weight = xlThin 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 12).Delete xlUp 'RAZ en dessous
End With
End Sub

Les résultats sont alors les mêmes que ceux de chris.