Copier une ligne dans une colonne

[oum]

Bonjour tout le monde
C’est la troisième fois que je poste et j’ai vraiment besoin de votre aide, je débute sur vba et je veux copier des cellules A2, B2 , C2, D2 E2 F2 et je veux les coller dans une autre feuille dans la colonne A c’est à dire A2 dans A2 / B2 dans A3 /C2 dans A4 ainsi de suite et s’il y a une cellule vide je passe à la cellule suivante
le problème du code que j’ai fait c’est qu’il ne me copie que la dernière colonne.
Voila le code

 Sub affecattion()

     Dim derniere_colonne As Long
     Dim colonne_en_cours As Long

     derniere_colonne = Sheets("cat").Cells(1, Columns.Count).End(xlToLeft).Column
     ligne = Sheets("affe").Range("A2").End(xlDown).Row + 1

 For colonne_en_cours = 1 To derniere_colonne

       If Cells(1, colonne_en_cours) = "" Then
                colonne_en_cours = colonne_en_cours + 1
 Else
              Sheets("affe").Cells(ligne, "A").Value = Sheets("cat").Cells(1, colonne_en_cours).Value

      End If

  Next

End Sub

voici le fichier et merci d’avance
test.xlsm (19,7 Ko)

[Zebulon]

Bonsoir oum,

Voici une proposition réalisée avec l’éditeur de macro.

Sub affecattion()

Application.StatusBar = “Patience SVP”
Application.ScreenUpdating = False

Dim intligne As Integer

For intligne = 1 To 15

Range(“L1”).Select
ActiveCell.FormulaR1C1 = “Article”
'Sélection des cellules à copier
Sheets(“cat”).Select
Range((“A” & intligne) & “:” & (“f” & intligne)).Select
Selection.Copy
'Transposition des cellules en colonne
Range(“L” & Rows.Count).End(xlUp).Offset(1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
Application.CutCopyMode = False

Next intligne

'Création du filtre
Columns(“L:L”).Select
Selection.AutoFilter
ActiveSheet.Range(“L:L”).AutoFilter Field:=1, Criteria1:="<>"
'Copie des articles
Range(“L1”).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'Copie des articles dans la feuille concernée
Sheets(“affe”).Select
Range(“A1”).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Effacement du filtre
Sheets(“cat”).Select
ActiveSheet.Range(“L:L”).AutoFilter Field:=1
Columns(“L:L”).Select
Application.CutCopyMode = False
Selection.ClearContents
Range(“A1”).Select
'Sélection feuille de destination pour contrôle
Sheets(“affe”).Select
Range(“A1”).Select

Application.StatusBar = False
Application.ScreenUpdating = True
Range(“A1”).Select

End Sub

Bonne soirée
Cordialement.