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

medmed94

XLDnaute Nouveau
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

XLDnaute Barbatruc
Bonjour

Voici un e macro qui devrait convenir
(Désolé de ne pas avoir pu répondre plus tôt)
Code:
Sub Macro_Urgente()
With Application
.ScreenUpdating = False
Range("A:C").Clear
Range("A1:B" & .RandBetween(16, 1600)) = Array(Chr(65) & Chr(66), Chr(66) & Chr(65))
Range("C1").Resize(Cells(Rows.Count, 1).End(3).Row) = "=A1&B1"
Range("A1").CurrentRegion.Borders.LineStyle = 1
.ScreenUpdating = True
End With
End Sub
 

eriiic

XLDnaute Barbatruc
Bonjour,

tu charries Staple, c'était urgent...

medmed94, il faut éviter ces mots dans les titres, ça fait plutôt fuir.
Eviter aussi les 'aidez-moi' etc, mettre un titre en rapport avec la question.
Si tous les topics sont titrés Urgent ou Aidez-moi, lequel tu ouvres après une recherche ?
eric
 

medmed94

XLDnaute Nouveau
Bonjour,

merci pour tout vos messages, je suis d'accord avec toi eriiiic pour le titre, au temps pour moi.

je te remercie pour la macros Staple1600, je me suis mal exprimer concernant cette dernière.
je met un fichier join pour expliquer au mieux ma demande.
je part de la structure de la feuille1 pour arriver à la structure de la feuille, en utilisant une macros.

cordialement.
 

Pièces jointes

  • Classeur1test .xlsx
    14.1 KB · Affichages: 21

Staple1600

XLDnaute Barbatruc
Bonsoir


Une macro en hommage à Richard Dean Anderson ;)
(A lancer quand on est sur la feuille 1 du classeur exemple)
VB:
Sub MacGyver_Angus()
Dim lig&, f$
f = "=IF(OFFSET(R1C1,(ROWS(R[-1]C[-1]:R1C[-1])-1)*10+COLUMNS(C1:C[-1])-1,)=0,"""",OFFSET(R1C1,(ROWS(R[-1]C[-1]:R1C[-1])-1)*10+COLUMNS(C1:C[-1])-1,))"
lig = Cells(Rows.Count, 1).End(3).Row
With Range("B2:K" & lig)
.FormulaR1C1 = f: .Value = .Value
End With
Range("B:B,D:D,F:F,H:H,J:J").Delete Shift:=xlToLeft: Range("F2:F" & lig).NumberFormat = "m/d/yyyy"
Range("B1:F1") = Array("Couleurs", "Nom", "Prénom", "Age", "Date de naissance")
End Sub
 

medmed94

XLDnaute Nouveau
Bonsoir,

merci infiniment pour la macros, mais elle ne fonctionne pas correctement quand je la lance elle me supprime les données de la feuille 1 et ne m'écrit rien dans la feuille 2 les données disparaissent.
j'aimerai que la macros part de la structure de la feuille 1 pour a l'arrivé j'obtiens la feuille 2 comme dans mon exemple .
Dans la macros que tu ma envoyés il me supprime des données et me mélange au niveau des colonnes.

cordialement,

merci pour le travail que tu as fait .
 
Dernière édition:

Staple1600

XLDnaute Barbatruc
Re

Avec celle-ci, il y a du mieux, mais c'est pas encore ça, hein ? ;)
Code:
Sub Test_2()
Dim Source As Range, c As Range, lig&, i&
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).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Application.CutCopyMode = False
i = i + c.Columns.Count
Next
End Sub
PS: Vider la feuille 2 avant de lancer la macro.
 

Discussions similaires