Macro VBA pour rendre vierge si champ recherche vide

ORFERYS

XLDnaute Nouveau
Bonjour a tous le forumeurs,

Je suis novice en VBA, mais volontaire pour m'améliorer.
J'ai construit un petit fichier de recherche sans grand mérite car j'ai pompé sur différents forums des petits bouts de code VBA.
Cela fonctionne plutôt bien sur mon fichier test en PJ,
Regarde la pièce jointe GPS search test.xlsm
mais dans sa version finale j'ai un plantage.

Principalement du au fait que certains onglets possèdent plus de 1.000.000,00 de lignes et que quand le masque de recherche est vide il affiche l'intégralité des lignes de chaque onglet soit un peu plus de 3.000.000,00 de lignes.

J'ai un premier code qui permet de faire une recherche sur tout ou partie d'une référence saisié

Sub Precision()
If Range("A9") = True Then
Range("B10:D10").Value = Range("B11:D11").Value
Else
If Range("B11") <> "" Then Range("B10") = "*" & Range("B11") & "*"
If Range("C11") <> "" Then Range("C10") = "*" & Range("C11") & "*"
If Range("D11") <> "" Then Range("D10") = "*" & Range("D11") & "*"
End If
Filtre
End Sub

Et un second sur le filtre, et nottament sur celui qui me pose problème

Sub Filtre()
Dim Ws As Worksheet
Dim Nblg As Long
Dim Ligne As Long
Dim Entete As Boolean

Application.ScreenUpdating = False
Ligne = 16
If Range("A" & Ligne) <> "" Then
Range("A" & Ligne & ":D" & Range("A" & Rows.Count).End(xlUp).Row).Clear
End If
For Each Ws In Sheets
If Ws.Name <> ActiveSheet.Name Then
With Ws
Nblg = .Range("A" & Rows.Count).End(xlUp).Row
.Range("A1:D" & Nblg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B9:D10"), copytorange:=Range("A" & Ligne)
If Entete = True Then
Range("A" & Ligne & ":D" & Ligne).Delete shift:=xlShiftUp
End If
Entete = True
Ligne = Range("A" & Rows.Count).End(xlUp).Row + 1
End With
End If
Next Ws

End Sub

Sur celui ci j'ai essayé tant bien que mal d'ajouter une petite ligne pour modifier si pas de recherche renseigne mais en vain.

If Application.WorksheetFunction.CountA(Range("B11:C11")) <> 0 Then Filtre

1 je ne sais ou le coller et malgré plusieurs essais j'ai une erreur systématique..

Si une âme charitable pouvait m'expliquer et m'accompagner dans cette modification cela serait super sympa

Amicalement
Christophe
 

Bebere

XLDnaute Barbatruc
Re : Macro VBA pour rendre vierge si champ recherche vide

bonjour CLS78
bienvenue

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Range("B11:D11"), Target) Is Nothing Then
If Range("A9") = True Then
Target.Offset(-1, 0) = Target
Else
Target.Offset(-1, 0) = "*" & Target & "*"
End If
If Application.WorksheetFunction.CountA(Range("B11:C11")) <> 0 Then Filtre
End If
End Sub