Discussion :

[ybrasse]

Bonsoir,

Je voudrais écrire le code VBA pour effectuer la copie de la sélection Range("K2,D5,D6,D7,D8,D9,D10,H5,H6,H7,H8,H9,H10,H11,L5,L6,L7,L8,L9,C16").select et coller cette sélection sur une autre feuille et dans les cellules Range("B2:B21").select.

Mon problème actuel est que c'est la dernière cellule, C16, qui se retrouve coller 20 fois dans la colonne B au lieu d'avoir K2 en B2, D5 en B3, ...

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
Sub Archiver()
 
Dim Cell As Range, Plage As Range
 
Sheets("Productions Végétales").Activate
Set Plage = Range("K2,D5,D6,D7,D8,D9,D10,H5,H6,H7,H8,H9,H10,H11,L5,L6,L7,L8,L9,C16")
For Each Cell In Plage
Cell.Copy
Sheets("Archives").Activate
For n = 2 To 21
Range("B" & n).Select
ActiveSheet.Paste
Next n
Next Cell
 
End Sub

Le but est en fait d'archiver les réponses d'un formulaire.

Merci pour vos contributions.

Cordialement,

Yoann.

[Invité]

Bonjour,

Essayez :

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
 
Sub Archiver()
 
Dim Cell As Range, Plage As Range
Dim I As Integer
 
    Set Plage = Sheets("Productions Végétales").Range("K2,D5,D6,D7,D8,D9,D10,H5,H6,H7,H8,H9,H10,H11,L5,L6,L7,L8,L9,C16")
    I = 1
    For Each Cell In Plage
        Cell.Copy Destination:=Sheets("Archives").Cells(I + 1, 2)
        I = I + 1
    Next Cell
    Set Plage = Nothing
 
End Sub

Sinon : Lorsque vous postez du code, sélectionnez le et cliquez sur le bouton # pour qu'il soit présenté comme mon code.

[ybrasse]

Merci beaucoup.

Cela fonctionne exactement comme demandé et ce fut très rapide.

Yoann.

[ybrasse]

Bonjour,

Est-il possible d'avoir un code permettant l'inverse, c'est à dire de reprendre les données archivées tout simplement en colonne et de les redispatcher dans la feuille d'origine aux emplacements bien spécifiques.
Pour être totalement clair, d'avoir B2 en K2, B3 en D5, ...

Merci d'avance.

[Invité]

A tester :

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
 
Sub RemettreLesValeursArchivees()
 
Dim Cell As Range, Plage As Range
Dim I As Integer
 
    Set Plage = Sheets("Productions Végétales").Range("K2,D5,D6,D7,D8,D9,D10,H5,H6,H7,H8,H9,H10,H11,L5,L6,L7,L8,L9,C16")
    I = 1
    For Each Cell In Plage
        Cell = Sheets("Archives").Cells(I + 1, 2)
        I = I + 1
    Next Cell
    Set Plage = Nothing
 
End Sub

[ybrasse]

Oui, super, cela fonctionne parfaitement.

Merci.