Création de boucles pour réduire la taille de mon code VBA

[_Nobody_]

Bonjour à tous

Je suis nouveau sur ce forum.
Je suis en stage de fin de DUT et j'ai a utiliser des macros sous excel.

Le soucis étant que je ne m'y connait vraiment mais alors vraiment pas .

Donc, je fais tout via l'utilitaire "enregistrer une macro" et je moifie le code par la suite, en fonction de ce que je comprends. Cependant, les boucles, je n'y comprends franchement pas grand chose.
Et là, je suis arrivé à ce qu'Excel m'indique : "Erreur de compilation : procédure
trop grande".

Donc j'ai vraiment besoin de votre aide !

Je sais déjà qu'il faudrait que j'arrive à réduire ce passage (j'ai quelques notion de codage en C, et je sais que ça doit être possible, mais je n'y arrive pas sur Excel ..).

Un passage qui doit être assez facilement réduit en boucle est le suivant :

    Range("B3:C3").Select
    Selection.Copy
    Range("B4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B5:C5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("B7:C7").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False


qui finit par :

    Range("B39:C39").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

 

[phlaurent55]

Re : Création de boucles pour réduie la taille de mon code VBA

Bonjour Nobody, et bienvenue sur le forum

essaie avec ce code:

Sub Macro1()
Dim cellule As Range
For Each cellule In Range("B4:C40")
If cellule.Value = "" Then cellule.Value = cellule.Offset(-1, 0).Value
Next cellule
End Sub

à+
Philippe

 

[_Nobody_]

Re : Création de boucles pour réduie la taille de mon code VBA

Merci beaucoup, c'est presque ça, mais ça ne fonctionne mas complètement.

Le soucis que j'ai, c'est que j'ai également des cases vides, que j'aimerais garder et recopier.

J'ai mis en pièce jointe, un exemple de tableau.

A gauche, ce que j'ai, à droite ce que je voudrais au final

Mercie encore de cette réponse rapide

En fait, j'aimerais aussi réduire le code que j'utilise pour la seconde partie de la réorganisation du tableau.
C'est à dire, copier la ligne du dessous dans la dernière colonne.
Le but de ce document est de pouvoir traver un graphique en escalier.

    Range("D5").Select
    Selection.Copy
    Range("D4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("D7").Select
    Application.CutCopyMode = False
    Selection.Copy


jusqu'à 

    Range("D40").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("F35").Select
    Application.CutCopyMode = False

 

[phlaurent55]

Re : Création de boucles pour réduire la taille de mon code VBA

Re,

essaie ceci:

Sub Macro1()
Dim cellule As Range
For Each cellule In Range("B4:C40")
If cellule.Value = "" Then cellule.Value = cellule.Offset(-1, 0).Value
Next cellule
For Each cellule In Range("D4:D40")
If cellule.Value = "" Then cellule.Value = cellule.Offset(1, 0).Value
Next cellule
End Sub

à+
Philippe

 

[_Nobody_]

Re : Création de boucles pour réduire la taille de mon code VBA

Finalement j'avais réussi avec votre exemple.

Ca fonctionne très bien !
Merci beaucoup.

 

[phlaurent55]

Re : Création de boucles pour réduire la taille de mon code VBA

Re,

en fonction du dernier fichier joint, il faut utiliser ce code qui vide les cellules de la colonne B si valeur 0 en colonne C

Sub Macro1()
Application.ScreenUpdating = False
Dim cellule As Range
For Each cellule In Range("B4:C40")
If cellule.Value = "" Then cellule.Value = cellule.Offset(-1, 0).Value
Next cellule
For Each cellule In Range("D4:D40")
If cellule.Value = "" Then cellule.Value = cellule.Offset(1, 0).Value
Next cellule
For Each cellule In Range("B4:C40")
If cellule.Offset(0, 1).Value = 0 Then cellule.Value = ""
Next cellule
Application.ScreenUpdating = True
End Sub

à+
Philippe

Edit: n'ayant pas rafraichi l'affichage avant de répondre, je n'avais pas vu que tu avais adapté:
il te reste à comparer ta solution avec la mienne