Sub Test4()
Dim n As Long, xRep As Long, xRow As Range, memeDate As Range
Dim newDate As Range, aCopier As Boolean
Application.ScreenUpdating = False
With Sheets("Reporting complet")
'init
aCopier = False
n = .Cells(.Rows.Count, 1).End(xlUp).Row
If n < 8 Then n = 8
.Range(.Cells(8, 1), .Cells(n, 1)).NumberFormat = "General"
Sheets("Réception").Range("AG9:CR11").Columns(1).NumberFormat = "General"
' lecture de la date sur la feuille "réception"
Set newDate = Sheets("Réception").Range("AG9")
' recherche si newDate existe dans la feuille "Reporting complet"
Set memeDate = Nothing
Set memeDate = .Columns("a").Find(What:=newDate, After:= _
.Range("A1"), LookIn:=xlValues) ' , lookat:=xlWhole
If memeDate Is Nothing Then
' la date ne figure pas dans feuille "Reporting complet"
aCopier = True
Else
'demande d'écrasement des vieilles données de "Reporting complet"
xRep = MsgBox("La date '" & Format(newDate, _
"dd mmm yyyy") & "' figure déjà dans la feuille " & _
" 'Reporting complet'." & vbLf & vbLf & _
"Doit-on écraser les anciennes valeurs (OK)" & vbLf & _
"ou bien annuler la copie (Annuler) ?", _
Buttons:=vbQuestion + vbOKCancel + vbDefaultButton2)
If xRep = vbOK Then
' on désire écraser -> demande d'une confirmation
xRep = MsgBox("Voulez-vous vraiment écraser les anciennes " & _
"valeurs pour la date " & Format(newDate, "dd mmm yyyy") & _
" ?", Buttons:=vbQuestion + vbYesNo + vbDefaultButton2)
If xRep = vbYes Then
aCopier = True
' boucle d'effacement
memeDate.EntireRow.Delete
Do
Set memeDate = Nothing
Set memeDate = .Columns("a").Find(What:=newDate, After:= _
.Range("A1"), LookIn:=xlValues, LookAt:=xlWhole)
If Not memeDate Is Nothing Then memeDate.EntireRow.Delete
Loop Until memeDate Is Nothing
End If
End If
End If
If aCopier Then
' recherche de la 1ere ligne vide sur la feuille "Reporting complet"
n = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
If n < 8 Then n = 8
' copie et collage de la ligne issue de la feuille "Réception"
Sheets("Réception").Range("AG9:CR11").Copy
.Cells(n, 1).PasteSpecial Paste:=xlPasteValues
.Cells(n, 1).PasteSpecial Paste:=xlPasteFormats
' tri selon la date
n = .Cells(.Rows.Count, 1).End(xlUp).Row
If n < 8 Then n = 8
.Range(.Cells(8, 1), .Cells(n, "BL")).Sort key1:=.Cells(8, 1), Header:=xlNo
End If
'finalisation
n = .Cells(.Rows.Count, 1).End(xlUp).Row
If n < 8 Then n = 8
.Range(.Cells(8, 1), .Cells(n, 1)).NumberFormat = "dd/mm/yyyy;@"
Sheets("Réception").Range("AG9:CR11").Columns(1).NumberFormat = "dd/mm/yyyy;@"
End With
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub
