Microsoft 365 CurrentRegion : sélection de cellules

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous,
Je vous souhaite une belle et chaude journée :)

Je n'arrive pas à adapter un code que Job75 m'a donné.
Le code était(pour appliquer une formule) :
VB:
Code origine Gérard
Sheets("Comptage_appels").Select
ActiveSheet.Unprotect Password:=""
    With [a1].CurrentRegion
    If .Rows.Count > 1 Then .Cells(4, 16).Resize(.Rows.Count - 1) = "=IF(OR(RC[-6]="""",RC[-5]=""""),"""",IF(VALUE(SUBSTITUTE(LEFT(RC[-6],8),""-"",""/"",1))=TODAY(),1,IF(MONTH(EOMONTH(VALUE(SUBSTITUTE(LEFT(RC[-6],8),""-"",""/"",1)),0))=MONTH(TODAY()),2,IF(MONTH(EOMONTH(VALUE(SUBSTITUTE(LEFT(RC[-6],8),""-"",""/"",1)),0))<MONTH(TODAY()),""3"",""""))))"
    .Columns(16) = .Columns(16).Value 'supprime les formules
    [P3] = "=SUM(RC[-4]:RC[-2])"
    End With
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
et fonctionne très dans le fichier pour lequel il a été fait.

J'ai tenté de le modifier comme suit pour faire une sélection de cellules :
Code:
With [a6].CurrentRegion
    If .Rows.Count > 1 Then .Cells(1, 16).Resize(.Rows.Count).Select
    'If .Rows.Count > 1 Then .Cells(1, 16).Resize(.Rows.Count).Select
    '.Cells(4, 16).Resize(.Rows.Count - 1)
    End With
Mais ça ne fonctionne pas et je n'arrive pas à trouver comment faire.

J'ai besoin que seules les cellules en colonnes P avec "RdV Fait" contenu en colonne "J" soient sélectionnées.

Pourriez-vous m'aider ?
Je joins un fichier test et je continue à bidouiller ;)

Un grand merci encore une fois,
Amicalement,
lionel,
 

Pièces jointes

  • CurrentRegion.xlsm
    52.4 KB · Affichages: 13
Dernière édition:
Solution
Fichier (2) avec création des listes de validation :
VB:
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...

Usine à gaz

XLDnaute Barbatruc
Bonsoir Laurent :)

Je te remercie pour ton code qui fonctionne bien.
J'avais trouvé la solution à ma demande du #post 40 avec le code de Gérard.

Ton code fonctionne parfaitement mais ne fait pas la validation me donnant la possibilité de changer l'affectation en "RdV Fait Annulé" pour les Rdvs annulés.

Mais je sais comment le modifier. Merci à toi :)

En pièce jointe le fichier test avec deux feuilles :
- Gérard,
- Laurent,

lionel,
 

Pièces jointes

  • CurrentRegion5.xlsm
    89.8 KB · Affichages: 6

laurent950

XLDnaute Barbatruc
Re,

J'ai corrigé les 2 Postes # 45 et #47
J'ai ajouté les filtres

Même code : "RdV Fait Annulé" Poste #47 Ou "RdV Fait" Poste #45

ici : Set Sch(UBound(Sch)) = .Find(What:="RdV Fait Annulé", LookIn:=xlValues)
et
ici: PlgSelect.Offset(, 6) = "RdV Fait Annulé"

VB:
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 Annulé", 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 Annulé"
        ' Filtre
            Rgn.AutoFilter Field:=1, Criteria1:=Sch(0).Value
            PlgSelect.Offset(, 6).Select
End Sub

Pour annuler les filtres d'une feuille c'est cela
Sub sélection()
ActiveSheet.ShowAllData
End Sub
 
Dernière édition:

Discussions similaires

Réponses
3
Affichages
166

Membres actuellement en ligne

Statistiques des forums

Discussions
314 645
Messages
2 111 536
Membres
111 185
dernier inscrit
Laurent.