Recopie automatiquement

[BRUNO62]

Bonjour,

J'ai besoin d'aide.
Ci-jt ma demande au travers du fichier joint.
Merci, d'avance
a+

 

[job75]

Re : Recopie automatiquement

Bonsoir BRUNO62,

Voyez peut-être cette macro à placer dans un module (Alt+F11) :

Sub Complete()
Dim i As Long
Application.ScreenUpdating = False
For i = Range("F65536").End(xlUp).Row To 1 Step -1
If Application.CountA(Cells(i, "F").Resize(, 6)) = 1 Then _
  Cells(i, "F").Resize(, 6) = Cells(i + 1, "F").Resize(, 6).Value
Next
End Sub

A+

 

[job75]

Re : Recopie automatiquement

Re,

Ou alors ceci, plus simple :

Sub Complete()
Dim i As Long
Application.ScreenUpdating = False
For i = Range("F65536").End(xlUp).Row To 1 Step -1
If [COLOR="Red"]Cells(i, "F") = Cells(i + 1, "F")[/COLOR] Then _
  Cells(i, "F").Resize(, 6) = Cells(i + 1, "F").Resize(, 6).Value
Next
End Sub

A+

 

[BRUNO62]

Re : Recopie automatiquement

Bonsoir job75,

Je te remercie pour ton retour mais j'ai omis une condition.
Ci-jt ma nouvelle demande.

Par avance merci
a+

 

[job75]

Re : Recopie automatiquement

Re,

Bon là on commence à faire mumuse, non ?

Sub Complete()
Dim i As Long
Application.ScreenUpdating = False
For i = Range("F65536").End(xlUp).Row To 1 Step -1
If Cells(i, "F") = Cells(i + 1, "F") Then _
  Cells(i, "H").Resize(, 3) = Cells(i + 1, "H").Resize(, 3).Value
Next
End Sub

A+

 

[job75]

Re : Recopie automatiquement

Re,

Plus sérieusement, s'il existe des valeurs (qu'on ne veut pas écraser) :

Sub Complete()
Dim i As Long, j As Byte
Application.ScreenUpdating = False
For i = Range("F65536").End(xlUp).Row To 1 Step -1
  If Cells(i, "F") = Cells(i + 1, "F") Then
    For j = 1 To 4
      If Cells(i, "F").Offset(, j) = "" Then _
        Cells(i, "F").Offset(, j) = Cells(i + 1, "F").Offset(, j)
    Next
  End If
Next
End Sub

A+

 

[BRUNO62]

Re : Recopie automatiquement

Bonsoir, bonsoir job75

Merci, c'est OK.
Désolé, pour ne pas avoir donner un retour rapide.

Grand merci !
A+