Discussion :

[wamkey]

J'ai un tableau de 4 colonnes.

Le nombre de cellule dans chacune des colonnes peut varier selon le moment où j'ouvre ce tableau.

La macro doit permettre de créer une colonne dans laquelle les 4 colonnes du tableau d'origine se superposent.

Le problème est donc que si pour la première colonne, il n'y a aucune difficulté, la macro ne sait jamais où les colonnes 2, 3 et 4 devront être collées. Il faudrait que chaque colonne soit collée juste en dessous de la précédente, donc dans la première cellule vide, ou encore, si vous préférez, sous la dernière cellule non-vide

je vous ai placé un script montrant la macro de base. Évidemment, là, c'est moi qui indique à la macro la cellule où le collage doit s'effectuer.

Une bonne âme saurait-elle me donner la baguette magique qui me permettra de transformer ces constantes en variable?

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
Sub copie4colonnesen1()
'
' copie4colonnesen1 Macro
'
 
'
    Range("A1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("B1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A6").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("C1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A15").Select
    ActiveSheet.Paste
    Sheets("Feuil1").Select
    Range("D1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Feuil3").Select
    Range("A28").Select
    ActiveSheet.Paste
End Sub

Merci d'avance pour vos réponses.

[Invité]

Bonjour,

Une solution possible avec ce code :

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
Sub Copie4ColonnesEn1V2()
 
 Dim ShSource As Worksheet
 Dim AireAcopier As Range
 Dim CelluleACopier As Range
 Dim PremiereLigneSource As Long
 Dim DerniereLigneSource As Long
 Dim NumeroColonne As Long
 
 Dim ShCible As Worksheet
 Dim LigneCibleEnCours As Long
 
    Set ShSource = Sheets("Feuil1")
    PremiereLigneSource = 1
 
    Set ShCible = Sheets("Feuil3")
    LigneCibleEnCours = 1
    ShCible.Columns(1).ClearContents
 
    For NumeroColonne = 1 To 4
 
        DerniereLigneSource = ShSource.Cells(ShSource.Rows.Count, NumeroColonne).End(xlUp).Row
        Set AireAcopier = ShSource.Range(ShSource.Cells(PremiereLigneSource, NumeroColonne), ShSource.Cells(DerniereLigneSource, NumeroColonne))
 
        For Each CelluleACopier In AireAcopier
            If CelluleACopier <> "" Then
               ShCible.Cells(LigneCibleEnCours, 1) = CelluleACopier
               LigneCibleEnCours = LigneCibleEnCours + 1
            End If
        Next CelluleACopier
 
        Set AireAcopier = Nothing
 
    Next NumeroColonne
 
    Set ShCible = Nothing
    Set ShSource = Nothing
 
End Sub

Cordialement.

[wamkey]

Salut Eric,

J'ai testé ta solution qui marche parfaitement. Juste une question toutefois:
Qu'est ce qui fait que ton copier/coller se fait sans prendre en compte les formats des cellules?

wamkey

[Invité]

Qu'est ce qui fait que ton copier/coller se fait sans prendre en compte les formats des cellules?

wamkey

Bonjour,

Parce que la propriété par défaut d'un objet range est value. Dans le code ci-dessous, on ne prend que la valeur.

Code :

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

 ShCible.Cells(LigneCibleEnCours, 1) = CelluleACopier

Cordialement.