XL 2016 macro VBA, passer d'une structure à une autre

[medmed94]

Bonjour,

J'aimerai concevoir une macros qui prend chaque lignes du tableau et les transformes en une seule colonne, en les imbriquant en structure ABAB.

Si vous avez des pistes ?

Cordialement,

 

[Staple1600]

Re

Avec cette version, c'est ok ?

Sub Test_3()
Dim Source As Range, c As Range, lig&, i&
vEnt = Array("Couleurs", "Nom", "Prénom", "Age", "Date de naissance")
lig = Feuil1.Cells(Rows.Count, 1).End(3).Row
Set Source = Feuil1.Range("A2:E" & lig)
i = 0
Application.ScreenUpdating = False
For Each c In Source.Rows
c.Copy
Feuil2.[A1].Offset(i, 0).Resize(5) = Application.Transpose(vEnt)
Feuil2.[A1].Offset(i, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Application.CutCopyMode = False
i = i + c.Columns.Count
Next
Feuil2.Columns("A:B").Columns.AutoFit: Feuil2.[A1].CurrentRegion.Borders.LineStyle = 1
End Sub

 

[medmed94]

t un génie ! super....

comment tu fais pour faire les bordure ?

 

[Staple1600]

Re

Bordures=Borders en anglais
Je te laisse donc deviner où dans la macro, le code s'occupe des bordures 😉

 

[medmed94]

super j'ai compris je te remercie infiniment !!!!!!!!!!!🙂

 

[medmed94]

tu as un mail pour te contacter plus rapidement si j'ai besoin d'aide la prochaine fois ? stp

 

[Staple1600]

Re

Voici mon mail:
lacoutumesurleforum@clepartgagedesconnaissances.com
ou celle-ci aussi
lessenceduforumcdetreplusieurs@pasdefairedu.peertopeer.com
😉

 

[medmed94]

merci😉

 

[job75]

Bonsoir medmed94, JM,

Voyez cette macro dans le fichier joint, elle utilise des tableaux VBA et est donc très rapide :

Private Sub Worksheet_Activate()
Dim ncol%, tablo, resu(), i&, j%, n&
With Feuil1.[A1].CurrentRegion 'CodeName de la feuille à adapter
    ncol = .Columns.Count
    tablo = .Resize(, ncol + 1) 'matrice, plus rapide, au moins 2 éléments
End With
ReDim resu(1 To ncol * UBound(tablo), 1 To 2)
For i = 2 To UBound(tablo)
    For j = 1 To ncol
        n = n + 1
        resu(n, 1) = tablo(1, j)
        resu(n, 2) = tablo(i, j)
Next j, i
'---restitution---
If FilterMode Then ShowAllData 'si la feuille est filtrée
With [A1] 'à adapter
    If n Then .Resize(n, 2) = resu: .Resize(n, 2).Borders.Weight = xlThin
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 2).Delete xlUp 'RAZ en dessous
End With
Columns("A:B").AutoFit 'ajustement largeur
With UsedRange: End With 'actualise la barre de défilement verticale
End Sub

Elle se déclenche quand on active Feuil2.

Bonne nuit.

 

[medmed94]

Bonjour,

Je vous remercie a tous pour l'aide que vous m'apporter c'est très gentil de votre part j'aimerai arrivé a ce schéma avec une macros s'il vous plait.
Comme sur l'autre je partirai de la feuille 1 vers la feuille 2.

cordialement.