MuscatMimi
XLDnaute Accro
Bonjour a tout le Forum
J'ai un soucis, que je n'arrive pas a trouver
Le Code Ci-dessous fonctionnait bien avant,,
maintenant,plus rien fonctionne
Sub Tranfert()
'-- Copie Données suivant Date Feuil1 Col C, dans Feuil2
Dim Cell As Range, DerLi As Long
Sheets("Feuil1").Activate
For Each Cell In Range("C2:C" & Range("C65536").End(xlUp).Row)
If Cell <= Date And Cell.Offset(, 6) = "" Then
Cell.Offset(, 6) = "X"
With Sheets("Feuil2")
On Error Resume Next
DerLi = .Range("A65536").End(xlUp).Row + 1
Range("A" & Cell.Row & ":" & "G" & Cell.Row).Copy .Range("A" & DerLi & ":G" & DerLi)
End With
End If
Next
End Sub
merci de votre aide par avnce
Cordialement
J'ai un soucis, que je n'arrive pas a trouver
Le Code Ci-dessous fonctionnait bien avant,,
maintenant,plus rien fonctionne
Sub Tranfert()
'-- Copie Données suivant Date Feuil1 Col C, dans Feuil2
Dim Cell As Range, DerLi As Long
Sheets("Feuil1").Activate
For Each Cell In Range("C2:C" & Range("C65536").End(xlUp).Row)
If Cell <= Date And Cell.Offset(, 6) = "" Then
Cell.Offset(, 6) = "X"
With Sheets("Feuil2")
On Error Resume Next
DerLi = .Range("A65536").End(xlUp).Row + 1
Range("A" & Cell.Row & ":" & "G" & Cell.Row).Copy .Range("A" & DerLi & ":G" & DerLi)
End With
End If
Next
End Sub
merci de votre aide par avnce
Cordialement