Microsoft 365 CurrentRegion : sélection de cellules

Sub sélection()
    With ActiveSheet 'Feuil1 'CodeName
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        .Columns(16).Validation.Delete 'RAZ
        With .Rows("6:" & .Range("j" & .Rows.Count).End(xlUp).Row)
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            .Rows.RowHeight = 55
            .Sort .Columns(10), xlAscending, Header:=xlNo 'tri
            Union(.Rows(0), .Rows).AutoFilter 10, "RDV Fait" 'filtre automatique
            On Error Resume Next 'si aucune SpecialCell
            With Intersect(.SpecialCells(xlCellTypeVisible), .Columns(16))
                Application.Goto .Cells(1), True 'sélectionne et cadre la 1ère cellule visible en colonne P
                .Validation.Add xlValidateList, Formula1:="Validé,Annulé"
            End With
            ActiveWindow.ScrollColumn = 1
            '.AutoFilter 'ôte le filtre
        End With
        End With
    ActiveCell.Offset(0, -6).Select
    ActiveCell.FormulaR1C1 = "=""RdV Fait ""&RC[6]"
    ActiveCell.Copy
    Range(ActiveCell.Offset(1, 0), Cells(Rows.Count, "j").End(xlUp)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.Offset(-1, 0).Select
End Sub
Sub Affiche()
'    'validation NON
    Selection.AutoFilter 'ôte le filtre
    Columns("J:J").Select
    Selection.Find(What:="RdV Fait", After:=ActiveCell, LookIn:=xlFormulas2, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate
 
    Range(ActiveCell.Offset(0, 0), Cells(Rows.Count, "j").End(xlUp)).Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    [p:p] = ""
    With [p:p].Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    Application.CutCopyMode = False
'[a1].Select
End Sub

Sub Gérard()
With [A1].CurrentRegion
    If .Rows.Count > 1 Then .Cells(2, 9).Resize(.Rows.Count - 1) = "=IF(RC[-1]<>"""",LOOKUP(RC[-1],km),"""")"
    .Columns(9) = .Columns(9).Value 'supprime les formules
End With
End Sub

Sub sélectionbis()
Dim Wks1 As Worksheet
    Set Wks1 = Worksheets("Feuil1")
    If Wks1.FilterMode Then Wks1.ShowAllData 'si la feuille est filtrée
    Dim Rgn As Range
        Set Rgn = Wks1.Range(Wks1.Cells(6, 10), Wks1.Cells(Wks1.Cells(65536, 10).End(xlUp).Row, 10))
        'remise à Zéro de la plage
        Rgn.Offset(, 6).Clear
    Dim Sch() As Range
    ReDim Sch(0 To 0)
    Dim Plg As String
    Dim PlgSelect As Range
    With Rgn
        Set Sch(UBound(Sch)) = .Find(What:="RdV Fait", LookIn:=xlValues)
            If Not Sch(UBound(Sch)) Is Nothing Then
                Do
                    ReDim Preserve Sch(UBound(Sch) + 1)
                    Set Sch(UBound(Sch)) = .FindNext(Sch(UBound(Sch) - 1))
                Loop While Not Sch(UBound(Sch)).Row = Rgn.Rows.Count + Rgn.Row - 1
            End If
    End With
        For i = LBound(Sch) To UBound(Sch)
            If Sch(0).Value = Sch(i).Value Then
                Plg = Plg & Sch(i).Address & ", "
            End If
        Next i
        Plg = Left(Plg, Len(Plg) - 2)
        Set PlgSelect = Range(Plg)
            PlgSelect.Offset(, 6) = "RdV Fait"
        ' Filtre
            Rgn.AutoFilter Field:=1, Criteria1:=Sch(0).Value
            PlgSelect.Offset(, 6).Select
End Sub