Transformer deux colones en une seule ligne

Bonjour ,

Pour un modèle d'import sur un Logiciel métier j'aurai besoin de transformer les deux colones en jaune en une seule ligne, j'ai fait un exemple manuel sur 04 lignes (voir la résultat sur la 2éme feuille) et je besoin d'appliquer la même chose sur toute la colonne B et C

Ci-joint le fichier et merci d'avance

Bonjour Ben haj, bonjour le forum,

Essaie comme ça :

Sub Macro1()
Dim OS As Worksheet
Dim OD As Worksheet
Dim TV As Variant
Dim I As Long
Dim K As Long
Dim TL() As Variant

Set OS = Worksheets("Priorité Article")
TV = OS.Range("A1").CurrentRegion
Set OD = Worksheets("Résultat")
OD.Cells.Clear
K = 2
For I = 1 To UBound(TV, 1)
    ReDim Preserve TL(1 To 2, 1 To K)
    TL(1, K - 1) = "'" & TV(I, 1)
    TL(1, K) = TV(I, 2)
    TL(2, K) = TV(I, 3)
    K = K + 2
Next I
OD.Range("A1").Resize(2 * UBound(TV, 1), 2).Value = Application.Transpose(TL)
With OD.Range("A1").CurrentRegion
    .Borders(xlEdgeLeft).LineStyle = xlContinuous
    .Borders(xlEdgeTop).LineStyle = xlContinuous
    .Borders(xlEdgeBottom).LineStyle = xlContinuous
    .Borders(xlEdgeRight).LineStyle = xlContinuous
    .Borders(xlInsideVertical).LineStyle = xlContinuous
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
For I = 2 To 2 * UBound(TV, 1) Step 2
    OD.Cells(I, 1).Resize(1, 2).Interior.ColorIndex = 6
Next I
OD.Range("A:B").VerticalAlignment = xlCenter
OD.Range("A:B").HorizontalAlignment = xlCenter
End Sub

Je n'ai pas pris le temps de commenter le code mais si tu en as besoin, demande le...

Bonjour le forum

Vois ceci :

Bon courage

Bonjour à tous,

@ Thauthème: ...je suis fasciné par ta faculté à rédiger des codes pareils

perso, je ne serai pas contre un commentaire de code.....il faut vraiment que j'arrive à comprendre l'utilisation des tableaux,

J'en suis encore à faire des boucles...

Sub test()
 Dim I As Integer, dl As Integer
 Dim derlig As Integer

  derlig = Sheets("Résultat").Range("A" & Rows.Count).End(xlUp).Row + 1

  With Sheets("Priorité Article")
   dl = .Range("A" & Rows.Count).End(xlUp).Row
    For I = 1 To dl
     .Range("A" & I).Copy Sheets("Résultat").Range("A" & derlig)
     derlig = derlig + 1
     .Range("B" & I & ":C" & I).Copy Sheets("Résultat").Range("A" & derlig)
     derlig = derlig + 1
    Next I
  End With
End Sub

Amitiés,

Re,

Le code commenté :

Sub Macro1()
Dim OS As Worksheet 'déclare la variable OS (Onglet Source)
Dim OD As Worksheet 'déclare la variable OD (Onglet Destination)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim I As Long 'déclare la variable I (Incrément)
Dim K As Long 'déclare la variable K (incrément)
Dim TL() As Variant 'déclare la variable TL (Tableau des Lignes)

Set OS = Worksheets("Priorité Article") 'définit l'onglet OS
TV = OS.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
Set OD = Worksheets("Résultat") 'définit l'onglet OD
OD.Cells.Clear 'efface le contenu de toutes les cellules de l'onglet OD (remise à zero)
K = 2 'initialise la variable K
For I = 1 To UBound(TV, 1) 'boucle sur toutes les lignes I du tableau des valeurs TV
    'redimensionne le tableau des lignes TL (2 lignes, K colonnes)
    ReDim Preserve TL(1 To 2, 1 To K)
    'dans la ligne au-dessous, j'ai mi une apostrophe devant car sinon certaines valeurs se transformaient en date ?!...
    TL(1, K - 1) = "'" & TV(I, 1) 'récupère dans la ligne 1, colonne K-1 de TL la donnée en colonne 1 de TV (=> transposition)
    TL(1, K) = TV(I, 2) 'récupère dans la ligne 1, colonne K de TL la donnée en colonne 2 de TV (=> transposition)
    TL(2, K) = TV(I, 3) 'récupère dans la ligne 2, colonne K de TL la donnée en colonne 3 de TV (=> transposition)
    K = K + 2 'incrémente K (ajoute deux colonnes au tableau des lignes TL)
Next I 'prochaine ligne de la boucle
'on a crée un tableau TL qui a récupéré les données de TV et les a ordonnées...
'renvoie dans la cellule A1 redimensionné de d'onglet OD le tableau TL transposé
OD.Range("A1").Resize(2 * UBound(TV, 1), 2).Value = Application.Transpose(TL)
'L'avantage de passer par des variables tableau c'est la rapidité d'exécution, l'inconvénient c'est les formats qu'il faut refaire par
'rapport au copier/coller

'le job est fait, tout le reste n'est plus que de la mise en page,
'bordures
With OD.Range("A1").CurrentRegion 'prend en compte les cellules adjacentes à A1 dde l'onglet OD
    .Borders(xlEdgeLeft).LineStyle = xlContinuous 'bordure ligne de gauche
    .Borders(xlEdgeTop).LineStyle = xlContinuous 'bordure ligne en haut
    .Borders(xlEdgeBottom).LineStyle = xlContinuous 'bordure ligne en bas
    .Borders(xlEdgeRight).LineStyle = xlContinuous 'bordure ligne de droite
    .Borders(xlInsideVertical).LineStyle = xlContinuous 'bordure verticale entres les cellules
    .Borders(xlInsideHorizontal).LineStyle = xlContinuous 'bordure horizontale entre les cellules
End With 'fin de la prise en compte de ...
'couleur jaune
For I = 2 To 2 * UBound(TV, 1) Step 2 'boucle une ligne sur 2
    OD.Cells(I, 1).Resize(1, 2).Interior.ColorIndex = 6 'couleur jaune
Next I 'prochaine ligne de la boucle
'alignement
OD.Range("A:B").VerticalAlignment = xlCenter 'alignement vertical centré
OD.Range("A:B").HorizontalAlignment = xlCenter 'alignement horizontal centré
End Sub

Très gentil compliment de Xorsankukai que je remercie mais faut éviter. Après je devient tellement imbu de moi-même et tellement c**, déjà que...

Re,

Très gentil compliment de Xorsankukai que je remercie mais faut éviter.

C'est amplement mérité,

Je te remercie pour tes explications, je décortiquerai tout ça à tête reposée car mes pauvres neurones ont été très sollicités aujourd'hui...

Amitiés,

TauThème : merci beaucoup