Boucle while

bonjour,
la solution c'est que quelqu'un m'a aider mais on est pas du tous passer pas une boucle while donc je pense que ce serais hors sujet ... voulez vous quand même que je l'explique ?

très bien ^^
Alors j'ai été aidé par pijaku et brunoM45 du forum Excel-pratique
Ils ont fait un travail remarquable,et de beaucoup de patience avec moi :/
Alors voilà ils ont modifié mon code afin que la température de ma base de données puissent s'incrémenter seule s'il n'y a pas de résultats obtenue dans la base de donnée.
s'il n'y a pas de résultats obtenue dans la base de donnée une macro propose a l'utilisateur d'incrémenter la température il aura alors le choix d'incrémenté la tmin tmax ou les deux puis il valide .
la température a donc la possibilité de s'incrémenter jusqu'à 100 fois de 5 en 5 tant qu'il n'y a pas de résultat. s'il y a un résultat l'incrémentation s'arrête et vous avez donc le résultats de la base de données.
Le code est le suivant :
Module 1.

Public Flag As Boolean
Public Premiere As Boolean
Public Quitter As Boolean
Public Incrémentation_de_Tmin As String
Public Incrémentation_de_Tmax As String
Public Incrémentation_des_deux As String

UserForm :

Private Sub CommandButton1_Click() 'Fermeture de la boite de dialogue apres un click sur "Valider"
Dim Cpt As Byte
   Incrémentation_de_Tmin = IIf(OptionButton1.Value = True, "OK", "NON")
   Incrémentation_de_Tmax = IIf(OptionButton2.Value = True, "OK", "NON")
   Incrémentation_des_deux = IIf(OptionButton3.Value = True, "OK", "NON")
   If MsgBox("confirmez-vous incrementation?", vbYesNo, "confirmation") = vbYes Then
      Unload Me
      For Cpt = 1 To 100
         If Quitter Then Quitter = False: Exit For
         If Incrémentation_de_Tmin = "OK" Then Range("F4").Value = Range("F4").Value - 5
         If Incrémentation_de_Tmax = "OK" Then Range("I4").Value = Range("I4").Value + 5
         If Incrémentation_des_deux = "OK" Then
            Flag = True
            Sheets("Feuil1").Range("F4:I4").Copy Sheets("Feuil2").Range("F1:I1")
            Sheets("Feuil2").Range("F1") = Sheets("Feuil2").Range("F1") - 5
            Sheets("Feuil2").Range("I1") = Sheets("Feuil2").Range("I1") + 5
            Sheets("Feuil2").Range("F1:I1").Copy Sheets("Feuil1").Range("F4")
         End If
      Next Cpt
   End If
End Sub

Private Sub CommandButton2_Click() ' Si l'on clique sur "Quittez" les valeurs des variables sont réinitialisées
  Unload UserForm2
End Sub

Private Sub UserForm_Initialize()
   OptionButton1.Value = False
   OptionButton2.Value = False
   OptionButton3.Value = False
   Quitter = False
   Premiere = True
End Sub

et code de la feuille de recherche :

Option Explicit

Private Sub CommandButton1_Click()
UserForm1.Show
End Sub

Private Sub CommandButton3_Click()
UserForm2.Show
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
   If Flag = False Then
      If Target.Count > 1 Then Exit Sub
   End If
   Flag = False
    If Not Application.Intersect(Target, Range("A4:O4")) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        For Each Cel In Range("A4:O4")
            If Cel <> "" Then
                If Not IsNumeric(Cel) Then
                    Cel.Offset(-1) = "*" & Cel.Value & "*"
                Else
                    Cel.Offset(-1) = Cel.Value
                End If
            Else
                Cel.Offset(-1).ClearContents
            End If
        Next Cel
        Application.EnableEvents = True
        Range("A6:P1000").AdvancedFilter Action:=xlFilterInPlace, _
        CriteriaRange:=Range("A2:O3"), Unique:=False
    End If
    Dim LgFin As Long
    LgFin = Range("A" & Rows.Count).End(xlUp).Row
    If Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") = 0 And Premiere = False Then
      UserForm2.Show
    ElseIf Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") = 0 And Premiere = True Then
    ElseIf Evaluate("SUBTOTAL(3,A7:A" & LgFin & ")") > 0 Then
      Quitter = True: Premiere = False
   End If
End Sub

Voilà j'espère que vous comprendrez quelque chose et n'hésitez pas à aller remercier le travail des deux personnes du forum d'Excel pratique :)

Bonne journée

de rien vous de même :)