Récapitulatif alphabétique de plusieurs feuilles

Sub TriRecap()
Dim i&, n&, z&, PlageR As Range, PlageA As Range, Sh As Worksheet, ShR As Worksheet
Set ShR = Sheets("Récapitulatif auteur")
ShR.Activate
n = ShR.Cells(65536, 1).End(xlUp).Row + 1
Set PlageR = ShR.Range(Cells(2, 1), Cells(n, 9))
PlageR.ClearContents
For i = 1 To Worksheets.Count
    Sheets(i).Activate
    If Sheets(i).Name <> ShR.Name Then
        z = Sheets(i).Cells(65536, 1).End(xlUp).Row
        n = ShR.Cells(65536, 1).End(xlUp).Row + 1
        Set PlageA = Sheets(i).Range(Cells(3, 1), Cells(z, 9))
        PlageA.Select
        PlageA.Copy Destination:=ShR.Range("A" & n)
    End If
Next i

ShR.Activate
n = ShR.Cells(65536, 1).End(xlUp).Row
Set PlageR = ShR.Range(Cells(2, 1), Cells(n, 9))
   PlageR.Select

    Range("A2").Select
    Selection.CurrentRegion.Select
    ActiveWorkbook.Worksheets("Récapitulatif auteur").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Récapitulatif auteur").Sort.SortFields.Add Key:= _
        Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Récapitulatif auteur").Sort
        .SetRange Range("A2:I" & n)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
End Sub