Microsoft 365 CurrentRegion : sélection de cellules

[Usine à gaz]

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) :

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 :

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,

 

[TooFatBoy]

Chez oim ça marche sur un fichier vierge avec juste quelques données en colonne J (le filtrage fonctionne correctement).
Essaye encore.

 

[Usine à gaz]

Bjr Marcel
tu es bien matinal lol.
Merci pour tes explications, je les garde

J'ai essayé des dizaines de fois ... rien à faire ça ne fonctionne pas
Il m'affiche toujours :
- avec RdV Fait annulé,
- avec RdV Fait Validé,
- avec RdV Fait,

lionel,

 

[TooFatBoy]

Euh... tu as bien enlevé la ligne
.AutoFilter 'ôte le filtre
à la fin de la macro ???

 

[Usine à gaz]

Ha ben NON lol, bon sang ! j'l'avais pas vu celui-là.
Merci Marcel, c'est bon maintenant,
Tu es mieux réveillé que moi lol,
lionel,

 

[TooFatBoy]

Mieux réveillé ??? Me suis pourtant pas encore couché... mais ça ne va peut-être pas tarder.

 

[job75]

Bonjour Lionel, Marcel32, le forum,

Oui si l'on veut voir uniquement 'RDV Fait" il ne faut pas ôter le filtre.

Mais à mon avis c'est gênant : quand et comment l'ôterez-vous ?

Le fait de voir toutes les cellules ne me paraît pas gênant.

Ce qui est important c'est qu'il y ait des listes de validation en colonne P juste pour "RDV Fait".

On pourrait colorer les cellules concernées en colonne P.

A+

 

[Usine à gaz]

Bonjour Gérard
Voici comment j'ai fait :

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

ça me permet d'affecter les "Validé" ou "Annulé" sans toucher aux "RdV Fait" traités précédemment.
Fichier joint,
ça fonctionne
Encore merci à toi
lionel,

 

[job75]

Oui tu compliques, tu compliques, c'est comme ça que tu fais des usines à gaz.

 

[Usine à gaz]

LOL, Je sais bien mais c'est pour intégrer une facturation automatique dans mon fichier de travail

 

[Usine à gaz]

Bonjour à toutes et à tous,
Je vous souhaite un beau WE

Je reviens sur le sujet car à l'utilisation j'aimerais apporter une amélioration.
Encore merci à Gérard pour son super code

Dans 1 mois, on peut prendre jusqu'à 100 (voire plus) RdVs.
Quelques uns sont annulés et il est plus rapide et moins fastidieux de mentionner uniquement les "RdV Fait Annulé"

Pour cela, j'aimerais que le code mentionne automatiquement pour toutes les cellules sélectionnées "RdV Fait Validé"

Mais lol (évidemment ), je n'arrive pas à coder correctement malgré mes tentatives :
Voici ce que je voudrais obtenir :

Auriez-vous le bon code ?
Je joins le fichier test et je continue mes recherches.
un grand merci
Amicalement,
lionel,

 

[job75]

Bonjour Lionel,

Dans ton dernier fichier tu mentionnes un code supposé créé par moi.

Il n'apparaît nulle part sur ce fil, où l'as-tu pêché ?

Je ne me souviens pas d'avoir utilisé une fonction nommée VALUE...

A+

 

[Usine à gaz]

Bonjour Gérard
C'est dans ce fil :

Microsoft 365 - Copier ma formule en I2 jusqu'au niveau de la dernière cellule non vide de la colonne H

Bonjour à toutes et à tous, Je vous souhaite une belle journée :) Je reviens pour un code que je crois avoir déjà obtenu il y a un bon moment et que je n'arrive pas à retrouver. selon mon fichier test joint, Je voudrais copier ma formule en I2 jusqu'au niveau de la dernière cellule non vide de...

www.excel-downloads.com

lionel,

 

[job75]

Dans ce fil il n'y a pas le code que tu as indiqué...

 

[Usine à gaz]

C'est le code du #post14 :

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

mais comme toujours, je l'ai modifié pour mon fichier de travail

 

[laurent950]

Bonsoir Lionel

Bon cette fois cela fonctionne très bien.

Pour les filtres et moteur de recherche il faut adapter

[Résolu] [Excel VBA] Moteur de recherche "filtrant" par Frakabass - page 1 - OpenClassrooms

openclassrooms.com

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