boucle pour copier/coller

[greg0852]

bonjour à tous,
J'ai une macro que je me sers pour faire un copier/coller de valeurs dans les cellules désignées.
Mon problème est que ma macro ne fonctionne que pour une seule cellule, et donc je dois la répéter à peu prés 6000 fois, puisque ma plage de cellule va de D4 à BM150.
Donc j'essaie désespérément de faire une boucle, mais sans succés.
Auriez-vous une idée de comment je pourrais m'y prendre. merci d'avance
Voici ma macro de base :

Sheets("Janv").Select
    Range("D4").Select
        If [D4] > 0 Then
    Application.CutCopyMode = False
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        End If

 

[Pierrot93]

Re : boucle pour copier/coller

Bonsoir,

si j'ai bien compris :

With Sheets("Janv").Range("D4:BM150")
    .Copy
    .PasteSpecial Paste:=xlPasteFormats
    .PasteSpecial Paste:=xlPasteValues
End With

bonne soirée
@+

 

[greg0852]

Re : boucle pour copier/coller

merci de ta réponse,
mais il ne doit faire un copier/coller que si le résultat de la cellule est différent de 0

 

[Pierrot93]

Re : boucle pour copier/coller

Re

modifie ainsi :

Dim c As Range
For Each c In Sheets("Janv").Range("D4:BM150")
    If c.Value > 0 Then
    With c
        .Copy
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=xlPasteValues
        End With
    End If
Next c

@+

 

[Efgé]

Re : boucle pour copier/coller

Bonjour greg0852, Bonjour et bonne année Pierrot93,
J'avais fait ça, peut être plus rapide:

Sub Test()
For Each C In Sheets("Janv").Range("D4:BM150")
    If C > 0 Then C.Value = C
Next C
End Sub

Cordialement

 

[greg0852]

Re : boucle pour copier/coller

Un grand merci à vous deux, Pierrot93 et Efgé. 😀
Vos deux macros marche nickel.
bonne année à tous les membres du forum