XL 2016 Reunir plusieurs onglets excel dans un seul

Private Sub Worksheet_Activate()
Dim P1 As Range, h1&, P2 As Range, h2&, P3 As Range, h3&
Set P1 = Feuil1.UsedRange.EntireRow: h1 = P1.Rows.Count
Set P2 = Feuil2.UsedRange.EntireRow: h2 = P2.Rows.Count
Set P3 = Feuil3.UsedRange.EntireRow: h3 = P3.Rows.Count
With [A5] 'cellule à adapter
    P1.Copy .Cells
    P2.Copy .Offset(h1)
    P3.Copy .Offset(h1 + h2)
    .Offset(h1 + h2 + h3).Resize(Rows.Count - h1 - h2 - h3 - .Row + 1).EntireRow.Delete 'RAZ en dessous
End With
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub

Private Sub Worksheet_Activate()
Dim P1 As Range, h1&, P2 As Range, h2&, P3 As Range, h3&
Set P1 = Feuil1.UsedRange.EntireRow.Offset(4): h1 = P1.Rows.Count - 4: If h1 < 0 Then h1 = 0
Set P2 = Feuil2.UsedRange.EntireRow.Offset(4): h2 = P2.Rows.Count - 4: If h2 < 0 Then h2 = 0
Set P3 = Feuil3.UsedRange.EntireRow.Offset(4): h3 = P3.Rows.Count - 4: If h3 < 0 Then h3 = 0
With [A5] 'cellule à adapter
    P1.Copy .Cells
    P2.Copy .Offset(h1)
    P3.Copy .Offset(h1 + h2)
    .Offset(h1 + h2 + h3).Resize(Rows.Count - h1 - h2 - h3 - .Row + 1).EntireRow.Delete 'RAZ en dessous
End With
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub

Private Sub Worksheet_Activate()
Dim titres&, dest As Range, w As Worksheet, P As Range, h&
titres = 4 'nombre de lignes des titres, à adapter
Set dest = Cells(titres + 1, 1) '1ère cellule de destination
For Each w In Worksheets
    If w.Name <> Me.Name Then
        Set P = w.UsedRange.EntireRow.Offset(titres): h = P.Rows.Count - titres: If h < 0 Then h = 0
        P.Copy dest 'copier-coller
        Set dest = dest.Offset(h) 'décale la cellule de destination
    End If
Next
dest.Resize(Rows.Count - dest.Row + 1).EntireRow.Delete 'RAZ en dessous
Columns.AutoFit 'ajustement largeur
With UsedRange: End With 'actualise les barres de défilement
End Sub