Microsoft 365 CurrentRegion : sélection de cellules

Usine à gaz

XLDnaute Barbatruc
Supporter XLD
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...

laurent950

XLDnaute Accro
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:

job75

XLDnaute Barbatruc
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 '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
End Sub
 

Pièces jointes

  • CurrentRegion (2).xlsm
    53.5 KB · Affichages: 5

Discussions similaires

Réponses
11
Affichages
396

Membres actuellement en ligne

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG