XL 2016 Copier et ne coller que les 12 dernières lignes

Adapter la cellule en jaune puis Données, Actualiser Tout

Sub Transfert()
Dim nlig&, fichier$, P As Range
nlig = 12 'modifiable
fichier = ThisWorkbook.Path & "\Destination.xlsx" 'chemin à adapter
Set P = [A1].CurrentRegion
If P.Rows.Count > nlig + 1 Then Set P = Union(P.Rows(1), P.Rows(P.Rows.Count - nlig + 1).Resize(nlig))
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
With Workbooks.Add(xlWBATWorksheet) 'nouveau document
    P.Copy Sheets(1).[A1] 'copier-coller
    .SaveAs fichier, 51 'format .xlsx
    .Close
End With
MsgBox "Transfert effectué..."
End Sub

Sub Transfert()
Dim nlig&, fichier$, a, n%, P As Range
nlig = 12 'modifiable
fichier = ThisWorkbook.Path & "\Destination.xlsx" 'chemin à adapter
a = Array("Source1", "Source2", "Source3") 'noms des feuilles à copier
Application.ScreenUpdating = False
Application.DisplayAlerts = False 'si le fichier a déjà été créé
With Workbooks.Add(xlWBATWorksheet) 'nouveau document
    For n = 0 To UBound(a)
        If n Then .Sheets.Add After:=.Sheets(n)
        .Sheets(n + 1).Name = a(n)
        Set P = ThisWorkbook.Sheets(a(n)).[A1].CurrentRegion
        If P.Rows.Count > nlig + 1 Then Set P = Union(P.Rows(1), P.Rows(P.Rows.Count - nlig + 1).Resize(nlig))
        P.Copy .Sheets(n + 1).[A1] 'copier-coller
    Next
    .Sheets(1).Activate
    .SaveAs fichier, 51 'format .xlsx
    .Close
End With
MsgBox "Transfert effectué..."
End Sub