transposer

Question

Bonjour,
j'ai un problème pour transposer des lignes en colonnes à chaque changement d'information, je vous remis l'exemple suivant afin que vous puissiez m'aider:

SB11BG4BLC
baguette blanc  12/4
1
0
3
0
0
7
45
0
65
0
0
0
0
2
#CART
SB11BG4BLU
baguette bleu   12/4
1
0
3
0
0
7
60
0
70
0
0
0
0
2
#CART
SB11BG4N
baguette noir    12/4
1
0
3
0
2
7
2
0
50
0
0
0
0
2
#CART
Lorsque je fais transposer, le resultat est sur la meme lignes, or je voudrais avoir trois lignes.
je souhaite que la fonction transposer finie à chaque fois qu'on trouve la cellule #CART.
bref avoir le resultat suivant:
ligne 1=SB11BG4BLCbaguette blanc  12/4	1	0	3	0	0	7	45	0	65	0	0	0	0	2	#CART
ligne 2=SB11BG4BLU	baguette bleu   12/4	1	0	3	0	0	7	60	0	70	0	0	0	0	2	#CART
ligne 3=SB11BG4N	baguette noir    12/4	1	0	3	0	2	7	2	0	50	0	0	0	0	2	#CART

je vous remercie de m'aider car mon fichier se compose de plusieurs lignes, et souhaite avoir un tableau...

Le Pingou · Answer

Bonjour,
Est-ce que les valeurs à transposer sont dans une seule colonne ?

Le Pingou · Answer

Bonjour,
Merci pour l’information.
Si la colonne est courte, vous pouvez copier la plage (A1 :A17) et coller/transposer et ensuite le deuxième bloc (A18 :A34) et coller/transposer, etc.

Ou bien vous utilisez cette procédure qui copie le bloc et le colle ligne par ligne dès colonne [C].

Sub transposer()
Dim d As Long, f As Long, lt As Long
lt = 1
nl = WorksheetFunction.CountA(Columns(1))
For d = 1 To nl
    f = WorksheetFunction.Match("#CART", Range("A" & d & ":A" & nl), 0)
    f = f + d - 1
    Range("A" & d & ":A" & f).Copy
    Cells(lt, 3).Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
    lt = lt + 1
    d = f
Next d
    Application.CutCopyMode = False
End Sub

manass · Answer

je vous remercie de votre réponse mais jai eu le message suivant après la transposition de plusieurs lignes:

erreur '1004' /
impossibe de lire la propriété Match de la classe Worksheetfuntion.

merci de votre suivi.

Le Pingou · Answer

Bonjour,
Merci pour l’information.
Chez moi, la procédure fonctionne sans erreur.
Sans savoir exactement à quel instant de la procédure se produit l’erreur, je n’ai pas de réponse.
Mettre le fichier sur https://www.cjoint.com/ et poster le lien !

Le Pingou · Answer

Bonjour,
La plage à traiter en feuille 1 et le résultat en feuille 2.
Sub transposer_v2()
Dim DeLi As Long, DeCo As Long, FiLi As Long, FiCo As Long, Nbre_colonne As Long
Dim Tablo
Dim C As Long, Co As Byte, Li As Long
Sheets("Feuil1").Activate 'à adapter au classeur
DeLi = Range("A1").Row
DeCo = Range("A1").Column
FiLi = Cells(65536, DeCo).End(xlUp).Row
FiCo = ActiveSheet.UsedRange.Columns.Count
Nbre_colonne = Application.CountA(Range(Cells(DeLi, DeCo), Cells(FiLi, FiCo)))
ReDim Tablo(Nbre_colonne - 1, 1)

Li = DeLi
Co = DeCo
For C = 0 To UBound(Tablo)
    If Not IsEmpty(Cells(Li, Co)) Then
        Tablo(C, 0) = Cells(Li, Co)
        Co = Co + 1
    Else
        Li = Li + 1
        Co = DeCo
        C = C - 1
    End If
Next
Sheets("Feuil2").Activate 'à adapter au classeur
Application.ScreenUpdating = False
Range("A1").CurrentRegion.Clear
With Range("A1").Resize(Nbre_colonne, 1)
    .Value = Tablo
    .Borders.Weight = xlThin
End With
End Sub

Transposer

5 réponses

Discussions similaires

Newsletters