boucler sur toutes les feuilles - 1 spécifiq

[Patrick]

Bonjour à toutes et à tous.

J'aimerais modifier une macro existante, mais je ne sais pas trop comment m'y prendre.

Suite au choix dans un listbox, la macro effectue une recherche de la valeur indiquée ds tt les feuilles du classeur, et ouvre la ou les feuilles en question.

Le pb c'est que j'aimerais éliminer de la recherche une feuille qui s'appelle 'listedossiers'.

Je joins ci-dessous la macro. Si quelqu'un peut m'aider à modifier ce code, ce serait sympa

merci par avance
Patrick

code:
Private Sub ListBox1_Click()

Dim strSearchString As String
Dim ws As Worksheet
Dim foundCell As Range
Dim returnValue As Variant
Dim countTot As Long
Dim counter As Long

strSearchString = ListBox1.Text
If ListBox1.Text = '' Then
MsgBox ('veuillez rentrer une valeur'), vbOKCancel
If vbCancel Then
Exit Sub
Unload UserForm1
End If
End If


For Each ws In Worksheets
countTot = countTot + Application.CountIf( _
ws.UsedRange, '=' & strSearchString)
Next ws


If countTot = 0 Then
MsgBox ' La valeur ' & strSearchString & Chr(10) & 'n'existe pas dans le planning.'
Else
counter = 0

For Each ws In Worksheets
With ws
.Activate
Set foundCell = .Cells.Find( _
What:=strSearchString, _
LookIn:=xlValues, _
LookAt:=xlPart)
If Not foundCell Is Nothing Then
counter = counter + 1
foundCell.Activate
returnValue = MsgBox('La valeur cherchée ' & strSearchString & _
' a été trouvé semaine: ' & ws.Name & ' cellule ' & foundCell.Address & vbNewLine & _
'(' & counter & ' de ' & countTot & ')', vbOKCancel)
If returnValue = vbCancel Then
Exit For
Else
If counter = countTot Then Exit For
End If
End If
End With
Next ws
Unload UserForm1
End If
End Sub

 

[porcinet82]

Salut Patrick,

Je n'ai pas testé mais je dirais quelque chose du genre :

For Each ws In Worksheets
    With ws
        .Activate
        'rajout de code ici
        If .Name = 'listedossiers' Then GoTo line1
     'le reste de ton code

    End With
'rajout de code ici
line1:
Next ws
Unload UserForm1
End If
End Sub

Je sais certains vont dire qu'il vaut mieux ne pas utiliser de Goto, mais je ne voyais pas comment faire autrement...

@+

Edition : Il faut enlever &nbs p;

Message édité par: porcinet82, à: 15/06/2006 19:02

 

[_Thierry]

Bonsoir Patrick, le Forum

Une approche en laissant tel quel ton code et sans vraiment tester...

Const FeuilleExclue As String = 'listedossiers'


Private Sub ListBox1_Click()

Dim strSearchString As String
Dim ws As Worksheet
Dim foundCell As Range
Dim returnValue As Variant
Dim countTot As Long
Dim counter As Long

strSearchString = ListBox1.Text
    If ListBox1.Text = '' Then
    MsgBox ('veuillez rentrer une valeur'), vbOKCancel
        If vbCancel Then
            Exit Sub
            Unload UserForm1
        End If
    End If


For Each ws In Worksheets
    If Not ws.Name = FeuilleExclue Then
        countTot = countTot + Application.CountIf(ws.UsedRange, '=' & strSearchString)
    End If
Next ws


    If countTot = 0 Then
        MsgBox ' La valeur ' & strSearchString & Chr(10) & 'n'existe pas dans le planning.'
    Else
    counter = 0
   
        For Each ws In Worksheets
          If Not ws.Name = FeuilleExclue Then
            With ws
                .Activate
                Set foundCell = .Cells.Find(what:=strSearchString, _
                                                  LookIn:=xlValues, _
                                                    LookAt:=xlPart)
                    If Not foundCell Is Nothing Then
                    counter = counter + 1
                    foundCell.Activate
                    returnValue = MsgBox('La valeur cherchée ' & strSearchString & _
                    ' a été trouvé semaine: ' & ws.Name & ' cellule ' & foundCell.Address & vbNewLine & _
                    '(' & counter & ' de ' & countTot & ')', vbOKCancel)
                        If returnValue = vbCancel Then
                            Exit For
                        Else
                                If counter = countTot Then Exit For
                        End If
                    End If
            End With
          End If
        Next ws
    Unload UserForm1
    End If
End Sub

Bonne fin de journée
[ol]@+Thierry[/ol]

EDITION !!!

Bonsoir Porcinet, désolé pas vu pas pris !!!

Message édité par: _Thierry, à: 15/06/2006 19:07

 

[porcinet82]

Salut _Thierry,

Pas de mal, je pense d'ailleur que même si j'ai été plus rapide sur ce coup, ton code est bien meilleur que le mien 😱

Au plaisir,

@+

 

[Patrick]

bonsoir Porcinet82 et Thierry

Thierry: J'ai testé ta solution, et c'est parfait !

Merci à vous deux pour ce petit coup de pouce
Patrick