Sub Macro2()
Dim nbRows As Long
Application.ScreenUpdating = False ' Stoppe le rafraichissement écran, Evite le flashage
'Filtrage de la plage et comptage des lignes filtrées
With ActiveSheet.Range("$B$7:$E$18")
'Filtrage des cellules vides
.AutoFilter Field:=1, Criteria1:="<>"
'Employer la fonction de feuille de calcul 'Sous.Total' pour avoir le nombre de ligne filtrées
nbRows = Application.Subtotal(3, .Columns(1)) - 1 '-1 pour ne pas compter la ligne d'entête
End With
'Si au moins 1 ligne affichée
If nbRows > 0 Then
'Copy des données
Range("B8:D18").Copy
'Collage des valeurs dans la feuille Base
'Voir l'aide excel vba sur End()
With Sheets("Base").Range("A" & Application.Rows.Count).End(xlUp)(2)
.Offset(, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
.Resize(nbRows).Value = Sheets("Feuil1").Range("C5").Value
End With
MsgBox nbRows & " ligne(s) exportée(s)"
End If
'Annuler le filtre
ActiveSheet.Range("B8:D14").AutoFilter
'Remettre à jour l'écran
Application.ScreenUpdating = True
End Sub