Discussion :

[tibiscuit]

Bonjour,

J'ai un fichier avec un nombre de lignes et de colonnes fixes mais qui peut évoluer dans l'avenir.

Grâce à une macro, j'aimerais copier le contenu de chaque colonne en dessous de la colonne B et recopier la colonne A à chaque fois.

Exemple, je veux que

	e	f	g
a	3	4	8
b		2	6
c	1	10

devienne

	e
a	3
b
c	1
	f
a	4
b	2
c	10
	g
a	8
b	6
c

Mais j'avoue que je sèche..

Merci d'avance

[Theze]

Bonjour,

Lancer la sub Test :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
58
59
 
Sub Test()
 
    Dim Fe As Worksheet
    Dim Plage As Range
    Dim Cel As Range
    Dim Ligne As Long
    Dim Col As Integer
    Dim I As Integer
 
    'ATTENTION, avant d'exécuter ce code, supprimer le tableau se trouvant sous le tableau source !
    'la feuille active
    Set Fe = ActiveSheet
 
    'défini la plage sur toute la feuille (trous dans les données)
    Set Plage = DefPlage(Fe)
 
    'nombre de colonne moins l car colonne A pour les entêtes de lignes
    Col = Plage.Columns.Count - 1
 
    'redéfini la plage sur la colonne A
    Set Plage = Plage.Columns(1).Cells
 
    'ligne de début d'inscription (2 lignes sous le tableau)
    Ligne = Plage.Rows.Count + 2
 
    'bouclage sur les colonnes...
    For I = 1 To Col
 
        'puis sur les cellules
        For Each Cel In Plage
 
            'inscription en colonnes A et B
            Fe.Range("A" & Ligne).Value = Cel.Value
            Fe.Range("B" & Ligne).Value = Cel.Offset(, I).Value
 
            'incrémente pour la ligne suivante
            Ligne = Ligne + 1
 
        Next Cel
 
    Next I
 
End Sub
 
Function DefPlage(Fe As Worksheet) As Range
 
    With Fe
 
        Set DefPlage = .Range(.Cells(1, 1), _
                       .Cells( _
                       .Cells.Find("*", .[A1], -4123, , _
                       1, 2).Row, _
                       .Cells.Find("*", .[A1], -4123, , _
                       2, 2).Column))
 
    End With
 
End Function

[tibiscuit]

Génial merci beaucoup !