Macro copier/coller colonnes de dimensions variables

Version imprimable

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 :D

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:

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.

Bonjour,

Une solution possible avec ce code :

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
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.

19/01/2014, 03h42
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
19/01/2014, 04h06
Invité

Citation:

Envoyé par wamkey

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:

ShCible.Cells(LigneCibleEnCours, 1) = CelluleACopier

Cordialement.