compil auto avec filtre

Salut Chris,

Je me dois d'assurer le SAV.....je t'invite à me joindre le bon fichier car j'ai visiblement des problèmes avec la PJ que tu as mis en annexe.

Bien cordialement

Rénato

Le voilà ...
merci beaucoup pour ta disponibilité
chris

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

salut RENATO
je vois que tu travailles encore à cette heure tardive...
merci beaucoup j'essaie et te tiens au courant....

Ca marche super bien
encore un grand merci pour ton aide qui m'a été très précieuse
Au fait c'est quoi ton job?
si celà n'est pas trop indiscret...

Salut Chris,

Bien content pour toi si ça marche.

Pour répondre à ta question, je ne travaille pas dans la restauration....pas plus que dans l'informatique.

Au plaisir.

Rénato