Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Macro qui ne fonctionne plus lorsqu'un filtre est présent


Sujet :

Macros et VBA Excel

  1. #1
    Membre à l'essai
    Macro qui ne fonctionne plus lorsqu'un filtre est présent
    Bonjour à tous,

    J'ai un fichier de suivi contenant des macros que j'ai créé moi même permettant de remplir un tableau dans un onglet B à partir d'informations remplies dans un onglet A.

    J'ai remarqué que le remplissage automatique de mon tableau dans l'onglet B ne fonctionnait plus lorsque j'applique un filtre sur l'onglet A.

    Avez-vous une idée de la manière dont je pourrais remplir mon tableau tout en ayant des filtres activés ?

    Merci d'avance pour vos réponses,

    Lubinovitch

  2. #2
    Expert éminent sénior
    Citation Envoyé par Lubinovitch Voir le message
    Avez-vous une idée de la manière dont je pourrais remplir mon tableau tout en ayant des filtres activés ?
    Pour ça, il faudrait, à minima, voir ce que fait ton code.
    Merci de cliquer sur pour chaque message ayant aidé puis sur pour clore cette discussion.

  3. #3
    Membre à l'essai
    Désolé je pensais que c'était un bug "connu" donc je n'avais pas mis mon code.

    le voici :

    Code :Sélectionner tout -Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
     
    Private Sub Worksheet_Change(ByVal Target As Range)
     
    Dim RechercheEND As Range
    Set RechercheEND = Worksheets("Suivi presta (Temps)").Columns(1).Cells.Find(what:="END", LookAt:=xlWhole)
     
    'REMPLISSAGE TABLEAU________________________________________________________________________________________________________________________________________
    Application.ScreenUpdating = False
     
    If Cells(2, 38) < 9 Then Cells(2, 38) = 9
    If Cells(2, 39) < 9 Then Cells(2, 39) = 9
     
    Dim Recherche As Range, Recherche2 As Range, RechercheSUIVIE As Range, RechercheCONF As Range
     
    Set RechercheSUIVIE = Worksheets("Suivi REVUES").Columns(24)
     
    Set Recherche = RechercheSUIVIE.Cells.Find(what:=Target.Row, LookAt:=xlWhole)
     
        'Suivi REVUES________________________________________________________________________________________________________________________________________
     
    With Target
            On Error GoTo ErrorHandler
            If .Column = 8 And (.Row < 3 Or .Row > 12) And .Row < RechercheEND.Row - 4 Then
     
                If IsNumeric(Target.Value) Then
     
                    If Target.Value + 0 > 0 Then
     
                        If Recherche Is Nothing Then
     
                            Worksheets("Suivi REVUES").Cells([AL2], 2).Value = .Offset(0, 0).Value
                            Worksheets("Suivi REVUES").Cells([AL2], 24).Value = Target.Row
                            Worksheets("Suivi REVUES").Cells([AL2], 5).Value = .Offset(0, -7).Value
                            Worksheets("Suivi REVUES").Cells([AL2], 6).Value = .Offset(0, -6).Value
                            Worksheets("Suivi REVUES").Cells([AL2], 7).Value = .Offset(0, 15).Value
                            With ActiveSheet.Range("AL2")
                                .Value = .Value + 1
                            End With
                        Else
                            Worksheets("Suivi REVUES").Cells(Recherche.Row, 2).Value = Cells(Target.Row, Target.Column).Value
                        End If
     
                    Else
                        Dim Reponse As Long  ' Variable numérique pour le choix de l'utilisateur.
     
     
                        Reponse = MsgBox("Voulez-vous effacer la ligne associée du tableau de suivi REVUE ?", _
                                        vbYesNo + vbExclamation + vbDefaultButton2, _
                                        "ATTENTION")
     
                        On Error GoTo ErrorHandler
     
                        If Reponse = vbYes And Cells(2, 38) > 9 Then
                            Worksheets("Suivi REVUES").Range(Recherche.Address).EntireRow.Delete
                            Worksheets("Suivi REVUES").Rows(1000).Insert
                            With ActiveSheet.Range("AL2")
                                .Value = .Value - 1
                            End With
                        End If
                    End If
                End If
            End If


    Il n'est surement pas optimisé au maximum mais il marche. Il fonctionne parfaitement sans filtre mais dès lors qu'il y en a un le remplissage ne se fait plus.