Copier coller celulle itération avec date

Bonjour,

La macro fonctionne uniquement sur une page. Vous avez modifié des range qui n'ont donné plus aucune logique à la macro.

Essayez donc avec ce code :

Sub test()
Dim rng As Range
Dim cell As Range
Dim i As Integer

i = 5
While (Cells(i, 10).Value <> "")
i = i + 1
Wend
Cells(i, 10).Select 'cellule de la page actuelle

Set rng = ActiveSheet.Range("B35")

With rng.Cells
.Copy
If ActiveSheet.Range("J5") = "" Then
ActiveSheet.Range("J5").PasteSpecial xlPasteValues 'endroit ou tu colles les données
End If

If ActiveSheet.Range("J5") <> "" Then
ActiveCell.PasteSpecial xlPasteValues
End If

ActiveCell.Offset(, -1).Value = Date 'entre la date dans la colonne précédente

End With

End Sub

Cordialement, Romain.

Re- Bonjour,

J'ai essayé d'adapter le code à un autre fichier. Et là, grand mystère le code ne marche plus !
Au début je n'avais pas rajouté Worksheets("BCC") devant Cells(i,10).Select mais alors : excel m'indique : erreur 1004 définie par l'application ou l'objet. J'ai cru comprendre qu'excel ne comprenait pas dans quelle sheet il devait prendre la cellule (i,10)

Le probleme est qu'une fois cet incident résolu alors : Il copie bel et bien une premiere fois la cellule voulue mais ensuite, il refuse de copier la même cellule sur la ligne suivante ...
Je ne comprends pas on a pourtant bien notre compteur qui s'incrémente dans notre boucle...

Puis je encore quémander votre aide?
Merci d'avance

Sub test()
Dim rng As Range
Dim cell As Range
Dim i As Integer

i = 5
While (Cells(i, 10).Value <> "")
i = i + 1
Wend
Worksheets("BCC").Cells(i, 10).Select

Set rng = ActiveSheet.Range("B35")

With rng.Cells
.Copy
If ActiveSheet.Range("J5") = "" Then
ActiveSheet.Range("B35").PasteSpecial xlPasteValues
End If

If ActiveSheet.Range("J5") <> "" Then
ActiveCell.PasteSpecial xlPasteValues
End If

ActiveCell.Offset(, -1).Value = Date 'entre la date dans la colonne A. Mettre -1 pour entrer la date dans la colonne F

End With

End Sub

merci bcp !! J'apprends bcp grâce à votre code
Encore merci :)

Voila, ça fonctionne !

Sub test()
Dim rng As Range, cell As Range
Dim i As Integer

i = 3
While (Cells(i, 7).Value <> "")
i = i + 1
Wend
Cells(i, 7).Select

Set rng = ActiveSheet.Range("B4")

With rng.Cells
.Copy
If ActiveSheet.Range("G3") = "" Then
ActiveSheet.Range("G3").PasteSpecial xlPasteValues
End If

If ActiveSheet.Range("G3") <> "" Then
ActiveCell.PasteSpecial xlPasteValues
End If

ActiveCell.Offset(, -6).Value = Date 'entre la date dans la colonne A. Mettre -1 pour entrer la date dans la colonne F

End With

End Sub

Cordialement, Romain.

Bonjour,

Essayez avec ceci (je suis aussi apprentis sorcier du VBA, mais voyons si cela fonctionne)

Sub miseajour() 

Dim lifin As Long, v
Dim cell As Range

v = ActiveSheet.Range("B4").Value 

lifin = ActiveSheet.Range("G1:G" & Range("G" & Rows.Count).End(xlUp).Row) 

If ActiveSheet.Range("G3") <> "" Then lifin = lifin + 1 
ActiveSheet.Range("G" & lifin).Value = v 
ActiveSheet.Range("F" & cell.Row).Value = Date
End If

End Sub 

PS : Je n'ai pas pu voir votre fichier, le site étant bloqué pour moi.

Cordialement, Romain.