Concatener les informations de plusieurs feuilles de colonne en ligne

Bonjour,

Voilà j'ai fichier qui a un certain nombre de feuilles avec la même structure. La ligne 1 et 2 sont les titres (sans importance), les champs commence à la ligne 3. La colonne A contient les titres et la colonne B les informations. Je souhaiterais une macro qui collecte les informations de la colonne B à partir de la ligne 3 à la ligne 21 en transposant, sachant que pour les titres je peux faire un copier-transpose.

Est ce que vous avez une idée?

Bonjour,

oui

P.

Ok j'ai trouvé,

Sub Assembler()

Dim i As Long, j As Long

Worksheets("SYNTHESE").Select

For i = 3 To Worksheets.Count - 2

j = Range("A65536").End(xlUp).Row + 1

With Worksheets(i)

Cells(j, 1).Value = .Range("B3").Value

Cells(j, 2).Value = .Range("B4").Value

Cells(j, 3).Value = .Range("B5").Value

Cells(j, 4).Value = .Range("B6").Value

Cells(j, 5).Value = .Range("B7").Value

Cells(j, 6).Value = .Range("B8").Value

Cells(j, 7).Value = .Range("B9").Value

Cells(j, 8).Value = .Range("B10").Value

Cells(j, 9).Value = .Range("B11").Value

Cells(j, 10).Value = .Range("B12").Value

Cells(j, 11).Value = .Range("B13").Value

Cells(j, 12).Value = .Range("B14").Value

Cells(j, 13).Value = .Range("B15").Value

Cells(j, 14).Value = .Range("B16").Value

Cells(j, 15).Value = .Range("B17").Value

Cells(j, 16).Value = .Range("B18").Value

Cells(j, 17).Value = .Range("B19").Value

Cells(j, 18).Value = .Range("B20").Value

Cells(j, 19).Value = .Range("B21").Value

End With

Next

End Sub

Si quelqu'un a une idée d'amélioration pour éviter de répéter les lignes en colonne

Bonjour,

quand tu mets un code ici il faut l'insérer entre les balises

P.

Option Explicit
Sub Assembler()
Dim i As Long, j As Long
Dim ToCop, Desti
Worksheets("SYNTHESE").Select
For i = 3 To Worksheets.Count - 2
   j = Range("A65536").End(xlUp).Row + 1
   With Worksheets(i)
      Set ToCop = .Range("B3:B21")
      Set Desti = Range("J65000").End(xlUp)
      ToCop.Copy
      Cells(j, 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
      Application.CutCopyMode = False
   End With
Next
[A2].Select
End Sub

C'est effectivement plus propre comme ça

Merci