XL 2021 copier des donnees en dessous un mot

Sub Copie()
    Dim DL%, PL%, T
    On Error GoTo Fin                                                   ' Si NRegister n'est pas trouvé
    DL = [B610000].End(xlUp).Row                                        ' DL dernière ligne à copier
    PL = 1 + Application.Match("NRegister", [B:B], 0)                   ' PL première ligne à copier
    T = Range(Cells(PL, "B"), Cells(DL, "P"))                           ' Copie de la plage dans un array
    With Sheets("Sheet3")
        DLsheet3 = .[A10000].End(xlUp).Row + 1                          ' Première ligne dispo en Sheet3
        .Cells(DLsheet3, "A").Resize(UBound(T, 1), UBound(T, 2)) = T    ' Copie des données
    End With
Exit Sub
Fin:
MsgBox "NRegister n'est pas trouvé en colonne B."                       ' Message d'erreur si non trouvé
End Sub

Private Sub Worksheet_Activate()
Dim c As Range
Application.ScreenUpdating = False
Cells.Delete 'RAZ
Set c = Sheets("Sheet1").Cells.Find("NRegister", , xlValues, xlWhole)
If c Is Nothing Then Exit Sub
c.Resize(c.End(xlDown).Row - c.Row + 1, 15).Copy [A1]
Columns.AutoFit 'ajustement largeurs
End Sub