Transfert de plusieurs colonnes VBA excel

abdouriabi Messages postés 16 Date d'inscription   Statut Membre Dernière intervention   -  
abdouriabi Messages postés 16 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour tout le monde,

Je reviens vers vous en espérant avoir une solution a mon petit souci:

En faite je souhaite transférer (automatiquement sans passer par des boutons) plusieurs colonnes( 5) non contigus d'une feuille a une autre dans le même classeur excel.
Après plusieurs recherches j'ai trouvé ce code (ci dessous) qui fonctionne très bien Le problème c'est que je dois le répéter 5 fois le code ce qui ralentit mon petit programme.
Quelqu'un peut m'aider s'il vous plais .


Dim ws1 As Worksheet
Dim ws2 As Worksheet

Set ws1 = Worksheets("Feuil1") 'ou nom de ta feuille de départ
Set ws2 = Worksheets("Feuil2") 'ou nom de ta feuille d'arrivée

Const Col_Depart = 1 ' N° de colonne de ta feuille de départ
Const Col_Arrivee = 1 'N° de colonne de ta feuille d'arrivée

Const Ligne_Depart = 1 ' N° de ligne de ta feuille de départ
Const Ligne_Arrivee = 1 'N° de ligne de ta feuille d'arrivée

ws1.Activate
ws1.Cells(Ligne_Depart, Col_Depart).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
ws2.Activate
ws2.Cells(Ligne_Arrivee, Col_Arrivee).Activate
ActiveSheet.Paste


En vous remerciant d'avance et en vous souhaitant une bonne après midi

Ps:VBA excel 2003

1 réponse

Réponse 1 / 1
abdouriabi Messages postés 16 Date d'inscription   Statut Membre Dernière intervention  
 
Bonsoir tout le monde

J'ai trouvé autre macros qui répond mieux a mes attentes , ce n'est pas pro mais ca marche, je l'ecris si jamais quelqu'un aura besoin...

'OPTION 2
Worksheets("Feuil1").Range("E:E").Copy Destination:=Worksheets("option2").Range("A:A")
Worksheets("Feuil1").Range("B:B").Copy Destination:=Worksheets("option2").Range("B:B")
Worksheets("Feuil1").Range("A:A").Copy Destination:=Worksheets("option2").Range("C:C")

'ACOMPTE 2

Worksheets("Feuil1").Range("G:G").Copy Destination:=Worksheets("ACOMPTE2").Range("A:A")
Worksheets("Feuil1").Range("B:B").Copy Destination:=Worksheets("ACOMPTE2").Range("B:B")
Worksheets("Feuil1").Range("A:A").Copy Destination:=Worksheets("ACOMPTE2").Range("C:C")

'MENU2

Worksheets("Feuil1").Range("K:K").Copy Destination:=Worksheets("MENU2").Range("A:A")
Worksheets("Feuil1").Range("B:B").Copy Destination:=Worksheets("MENU2").Range("B:B")
Worksheets("Feuil1").Range("A:A").Copy Destination:=Worksheets("MENU2").Range("C:C")


A bientot
0