macro - columns to lines

2 pièce(s) jointe(s)

Bonjour,

Je souhaiterais creer une macro qui reecrive les valeurs d'une colonne sur une ligne. je joins 2 images representant le fichier initial ou les valeurs sont ecrites dans la 2ieme colonne et l'autre image presentant ce que je souhaiterais faire.
Comme vous pouvez le voir sur l'image avec les 2 colonnes, la 1ere valeur commence sur la ligne 12. Il y a aussi 33 lignes entre les deux A. Sur ces images, A B C ne se repetent que 2 fois mais en realité cela se repete au moins 200 fois dans mon fichier excel (j'ai limité a 2 repetition juste pour l'exemple)

merci pour votre aide.

Bonjour à toi,

Je te propose la solution suivante. Je l'ai rapidement testée et je ne sais pas si elle fonctionnera sur ton programme entier. Tiens mois au courant !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
Sub Col_Row()
 
Dim row_ori As Integer
Dim col_ori As Integer
Dim row_des As Integer
Dim col_des As Integer
 
Dim off As Integer
 
row_ori = 1
col_ori = 2 'A modifier en fonction de la colonne ciblée => celle où se trouve les "A", "B" et "C"
 
row_des = 1
 
 
 
With Worksheets("Feuil1")
    For i = 1 To .Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row
        Select Case .Cells(i, col_ori).Value
            Case "A"
                off = 0
                col_des = 1
                Worksheets("Feuil2").Cells(row_des, col_des) = .Cells(i, col_ori)
                Do While .Cells(i + off, col_ori + 1).Value <> "" And .Cells(i + off, col_ori) <> "B" And .Cells(i + off, col_ori) <> "C"
                    col_des = col_des + 1
                    Worksheets("Feuil2").Cells(row_des, col_des) = .Cells(i + off, col_ori + 1)
                    off = off + 1
                Loop
                row_des = row_des + 1
 
            Case "B"
                off = 0
                col_des = 1
                Worksheets("Feuil2").Cells(row_des, col_des) = .Cells(i, col_ori)
                Do While .Cells(i + off, col_ori + 1).Value <> "" And .Cells(i + off, col_ori) <> "A" And .Cells(i + off, col_ori) <> "C"
                    col_des = col_des + 1
                    Worksheets("Feuil2").Cells(row_des, col_des) = .Cells(i + off, col_ori + 1)
                    off = off + 1
                Loop
                row_des = row_des + 1
 
            Case "C"
                off = 0
                col_des = 1
                Worksheets("Feuil2").Cells(row_des, col_des) = .Cells(i, col_ori)
                Do While .Cells(i + off, col_ori + 1).Value <> "" And .Cells(i + off, col_ori) <> "A" And .Cells(i + off, col_ori) <> "B"
                    col_des = col_des + 1
                    Worksheets("Feuil2").Cells(row_des, col_des) = .Cells(i + off, col_ori + 1)
                    off = off + 1
                Loop
                row_des = row_des + 2
        End Select
    Next i
 
End With
 
End Sub

Cette solution cible "feuil1" et met les résultats sur "feuil2".
Programme à améliorer et optimiser, pour sûr !

Merci bcq!
Ca marche parfaitement.