Boucle VBA
Résolumaryonc -
Bonjour,
Je dois automatiser un fichier excel mais mes compétences techniques sont assez limitées.
J'ai un fichier qui contient plusieurs feuilles.
Sur une des feuilles je dois me positionner en cellule A3 copier un code produit, le coller en valeur en cellule A1 afin que cela calcule des données sur une autre feuille.
Les données calculées sur cette feuille doivent ensuite être collées sur une autre. Et ainsi de suite pour tous les codes produits. Cela commence en A3 et fini en A393.
Je cherche un code afin de ne pas avoir à faire les copier/coller à la main.
Merci de votre aide!
3 réponses
-
yg_be Messages postés 23437 Date d'inscription Statut Contributeur Dernière intervention Ambassadeur 1 588
bonjour,
Tu peux commencer le code avec l'enregistreur de macros, en faisant l'opération sur quelques lignes.
Montre nous ensuite le code obtenu, nous pourrons te suggérer comment y ajouter une boucle.
-
Bonjour uy_be,
Merci pour ton retour.
Voici le code sur les 3 premières cellules :
Sub Macro5()
'
' Macro5 Macro
''
Range("E3").Select
Application.CutCopyMode = False
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IRIS").Select
Range("BT1:BV1").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("test").Select
Range("E1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("H1").Select
Sheets("Param").Select
Range("E4").Select
Application.CutCopyMode = False
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IRIS").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("test").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Param").Select
Range("E5").Select
Application.CutCopyMode = False
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("IRIS").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("test").Select
Range("K1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N1").Select
Sheets("Param").Select
End Sub
Merci encore pour ton aide :)
-
Avant de faire une boucle, peux-tu vérifier si ceci fait la même chose?
Sheets("Param").Range("E3").Copy Sheets("Param").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range(Sheets("IRIS").Range("BT1:BV1"), Sheets("IRIS").Range("BT1:BV1").End(xlDown)).Copy Sheets("test").Range("E1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Param").Range("E4").Copy Sheets("Param").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range(Sheets("IRIS").Range("BT1:BV1"), Sheets("IRIS").Range("BT1:BV1").End(xlDown)).Copy Sheets("test").Range("H1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Param").Range("E5").Copy Sheets("Param").Range("A2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range(Sheets("IRIS").Range("BT1:BV1"), Sheets("IRIS").Range("BT1:BV1").End(xlDown)).Copy Sheets("test").Range("K1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False -
-
Je propose alors ceci, qui s'arrête quand il rencontre une cellule vide en E
dim rparamE as range, rparamA2 as range, riris as range, rtest as range set rparamE = Sheets("Param").Range("E3") set rparamA2 = Sheets("Param").Range("A2") set riris = Range(Sheets("IRIS").Range("BT1:BV1"), Sheets("IRIS").Range("BT1:BV1").End(xlDown)) set rtest = Sheets("test").Range("E1") do while rparamE <> "" rparamE.Copy rparamA2.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False riris.Copy rtest.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False set rparamE = rparamE.offset(1) set rtest = rtest.offset(3) loopAu lieu d'avancer de 3 lignes dans "test", il est possible de s'adapter au nombre de lignes copiées à partir de "iris".
-
-
-
-
