Salut Chris,
Si j'ai bien compris ton problème, en collant, en annule et remplace le listing ci-dessous dans ta macro "denoncer"...ça devrait arranger ton problème.
Bien cordialement
Rénato
Sub denoncer()
Dim ms As String
ms = MsgBox("pour confirmer la création d'une synthèse des dégustations Cliquez Ici", vbOKCancel)
If ms = vbOK Then
Dim arr As New Collection
Dim cptr, lig As Long
lig = Range("A5").End(xlDown).Row
cptr = 5
While cptr <= lig
If Cells(cptr, 6) <= 5 Then
arr.Add Range(Cells(cptr, 1), Cells(cptr, 9)).Value
End If
cptr = cptr + 1
Wend
Sheets(2).Activate
Application.ScreenUpdating = False
lig = Columns(1).Find("", [A1], , , xlByRows).Row - 1
nbre = arr.Count
cptr = 1
While cptr <= nbre
Range(Cells(cptr + lig, 1), Cells(cptr + lig, 9)) = arr(cptr)
cptr = cptr + 1
Wend
Range(Cells(2, 1), Cells(cptr + lig, 9)).Borders.Weight = xlThin
Set arr = Nothing
End If
With Range("F1", Range("F65536").End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Range("F65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("a1").Select
ActiveCell.EntireRow.Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete shift:=xlUp
Range("A1").Select
End Sub
