XL 2013 Macro / Copier sans suppression

Sub Extrait()
For lig = 4 To [A65536].End(3).Row
onglet = Cells(lig, 3).Text
bas = Sheets(onglet).[A65000].End(3).Row + 1
Sheets(onglet).Range("A" & bas & ":I" & bas).Value = _
Range("A" & lig & ":I" & lig).Value
Next
End Sub

Option Explicit

Sub copie()
Dim i As Long, sh As Object, j&
Application.ScreenUpdating = False
With Sheets("Donnée de base")
For j = 3 To 7
Sheets(j).Select
Range("A4:I65536").Clear
Next j
For i = 4 To 65536
If .Cells(i, 1) = "" Then
Sheets("Donnée de base").Select
Exit Sub
End If
For Each sh In Sheets
    If sh.Name = .Cells(i, 3) Then
   Range(.Cells(i, 1), .Cells(i, 9)).Copy
   sh.Select
   If Range("A4") = "" Then
   Range("A4").Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
   Exit For
   Else
   Range("A3").End(xlDown).Offset(1, 0).Select
   ActiveSheet.Paste
   Application.CutCopyMode = False
   Exit For
   End If
   End If
  Next sh
Next i
End With
Application.ScreenUpdating = True
End Sub

Sub Extrait()
Dim w As Worksheet
Application.ScreenUpdating = False
With Sheets("Donnée de base").UsedRange.Offset(2).Resize(, 9) 'adapter si nécessaire
    For Each w In Worksheets
        If w.Name <> "Accueil" And w.Name <> .Parent.Name Then
            .AutoFilter 3, w.Name 'filtre automatique
            If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
            w.Rows("4:" & w.Rows.Count).Delete 'RAZ
            .Copy w.Range("A3") 'copier-coller
            w.DrawingObjects.Delete 'supprime le bouton copié
        End If
    Next
    .AutoFilter 'retire le filtre
    .Cells(1).Copy .Cells(1) 'vide la mémoire
End With
End Sub

Sub Extrait()
Dim w As Worksheet, n&
Application.ScreenUpdating = False
With Sheets("Donnée de base").UsedRange.Offset(3).Resize(, 9) 'adapter si nécessaire
    If .Parent.FilterMode Then .Parent.ShowAllData 'si la feuille est filtrée
    .Cells(1, 10) = 1: .Columns(10).DataSeries 'numérotation en colonne J
    If .Rows.Count > 3 Then
        .Cells(1, 10) = 1
        .Columns(10).Resize(.Rows.Count - 3).DataSeries 'numérotation en colonne J
        .Resize(, 10).Sort .Columns(3), Header:=xlNo 'tri sur la colonne C
    End If
    .Resize(, 10).Sort .Columns(3), Header:=xlNo 'tri sur la colonne C
    For Each w In Worksheets
        If w.Name <> "Accueil" And w.Name <> .Parent.Name Then
            If w.FilterMode Then w.ShowAllData 'si la feuille est filtrée
            w.Rows("4:" & w.Rows.Count).Delete 'RAZ
            n = Application.CountIf(.Columns(3), w.Name)
            If n Then .Rows(Application.Match(w.Name, .Columns(3), 0)).Resize(n).Copy w.Range("A3") 'copier-coller
        End If
    Next
    .Resize(, 10).Sort .Columns(10), xlAscending, Header:=xlNo 'tri sur la olonne J pour rétablir l'ordre initial
    .Columns(10).ClearContents
End With
End Sub