Discussion :

[pael013]

Bonjour,
Je demande de l'aide car je n'arrive pas à mettre ne place une macro pour copie des données d'une colone sous une autre.
Je vous explique plus concrètement:

j'ai 800 individus qui sont mes lignes, ces individus prennent plusieurs valeurs (valeur 1, valeur 2 valeur 3).

j'essaye de copier la colonne 2 pour la mettre dans la colonne 1 en dessous des données de la colonne 1. ensuite copier la colonne 3 dans la colonne 1 en dessous des données de la colonne1( =Colonne 1+2).

J'essaye de faire ca avec un macro, mais j'ai des difficultés !!!
Quelqu'un a-il le temps de m'aider?

Je vous mets en fichier joint un exmple avec 24 lignes et le résultat que je voudrais avoir.

[Krovax]

Bonjour
Sans ouvrir le fichier exemple

Code :

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

1
2
3
4
5
6
Sub ddfgg()
Dim col As Integer
For col = 2 To  Range("IV1").End(xlToLeft).Column
Range(Cells(1, col), Cells(Cells(Columns(col).Cells.Count, col).End(xlUp).Row, col)).Copy Range("A" & Cells(Columns(1).Cells.Count, 1).End(xlUp).Row + 1)
Next col
End Sub

A comprendre et adapter en cas de question n'hésite pas
un lien pour t'aider
http://www.developpez.net/forums/d45...gnees-feuille/

[diude54]

Ceci devrait marcher, du moins ça devrait t'aider à adapter à ton cas

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
 
Sub g()
Dim col1 As Long
 
col1 = Range("A65536").End(xlUp).Row 'dernière ligne de la colonne A
 
Range("A2", "A" & col1).Copy
ActiveSheet.Paste Destination:=ActiveSheet.Range("A" & col1 + 1)
 
Range("C2", "C" & col1).Copy
ActiveSheet.Paste Destination:=ActiveSheet.Range("B" & col1 + 1)
 
Range("A2", "A" & col1).Copy
ActiveSheet.Paste Destination:=ActiveSheet.Range("A" & col1 * 2)
 
Range("D2", "D" & col1).Copy
ActiveSheet.Paste Destination:=ActiveSheet.Range("B" & col1 * 2)
 
Range("C1", "D" & col1).Clear
 
End Sub

[pael013]

Ok !!! Parfait
En fait mes colonnes ont une taille identique (ex:200) mais certaines d'entres elles ont des cellules vides en fin de colonne.

De plus j'ai plusieurs colonnes (environ 100), j'essaye donc de mettre en place une boucle !!!

Merci

[Krovax]

Remplace les

Code :

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

Cells(Cells(Columns(col).Cells.Count, col).End(xlUp).Row

par 200

Diude je te conseille d'utiliser la copie directe ca évite de passer par le presse papier qu'il faut parfois vider

[pael013]

effectivement la copie directe est plus pratique !!!
mais j'ai une dernier probleme,
puisque meme si je lui definit la taille (ex:200), en remplacant

Code :

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

Cells(Cells(Columns(col).Cells.Count, col).End(xlUp).Row

par 200


et si en fin de colonne j'ai des cellules vides, il ne me les copie pas ...

[Krovax]

en fait il faut modifier un petit truc sur la destination car il copie a partir de la ligne suivant la dernière

Code :

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

1
2
3
4
5
6
7
 
Sub ddfgg()
Dim col As Integer
For col = 2 To  Range("IV1").End(xlToLeft).Column
Range(Cells(1, col),cells(200,col)).Copy Range("A" & 200*(col-1)+1)
Next col
End Sub

Il va peut être te falloir adapté le 200*(col-1)+1
la deuxième colonne est copié a partir de la ligne 201 la troisième ligne 401....

[diude54]

Je te propose ça:

Code :

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

1
2
3
4
5
6
7
8
9
Sub ddfgg()
Dim col As Integer
a = 201
For col = 3 To Range("IV1").End(xlToLeft).Column
Range("A1", "A200").Copy Range("A" & a)
Range(Cells(1, col), Cells(200, col)).Copy Range("B" & a)
a = a + 200
Next col
End Sub

Si c'est la colonne A qui est la plus grande tu peux faire:

Code :

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

1
2
3
4
5
6
7
8
9
Sub ddfgg()
Dim col As Integer
a = range("A65536").end(xlup).row +1
For col = 3 To Range("IV1").End(xlToLeft).Column
Range("A1", "A200").Copy Range("A" & a)
Range(Cells(1, col), Cells(a-1, col)).Copy Range("B" & a)
a = a + a-1
Next col
End Sub

Comme ça il trouve tout seul le 200.