Boucle VBA

Résolu/Fermé
maryonc - 12 sept. 2022 à 18:07
 maryonc - 13 sept. 2022 à 16:24

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 22731 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 avril 2024 1 477
12 sept. 2022 à 18:35

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.

0

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

0
yg_be Messages postés 22731 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 avril 2024 1 477
13 sept. 2022 à 09:53

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

0
maryonc > yg_be Messages postés 22731 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 avril 2024
13 sept. 2022 à 11:06

Oui cela fait exactement la même chose!

0
yg_be Messages postés 22731 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 avril 2024 1 477 > maryonc
13 sept. 2022 à 11:29

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)
loop

Au lieu d'avancer de 3 lignes dans "test", il est possible de s'adapter au nombre de lignes copiées à partir de "iris".

0
maryonc > yg_be Messages postés 22731 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 avril 2024
13 sept. 2022 à 11:42

ça commence à ressembler à quelque chose sauf que mes données ne se collent pas dans les colonnes à la suite des autres mais en lignes :

Les données relatives à chaque nouveaux codes devraient venir se coller comme ceci (comme avec le premier code que tu m'as donné) :

0
yg_be Messages postés 22731 Date d'inscription lundi 9 juin 2008 Statut Contributeur Dernière intervention 27 avril 2024 1 477 > maryonc
13 sept. 2022 à 12:04

Oups, la ligne 15 doit être 

set rtest = rtest.offset(,3)
0

Un grand merci pour ton aide et les explications. C'est très clair!

0