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("B1010").Value = Range("B1111").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 & "" & 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" & Nblg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B910"), copytorange:=Range("A" & Ligne)
If Entete = True Then
Range("A" & Ligne & "" & 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
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("B1010").Value = Range("B1111").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 & "" & 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" & Nblg).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range("B910"), copytorange:=Range("A" & Ligne)
If Entete = True Then
Range("A" & Ligne & "" & 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