XL 2019 Besoins d'aide pour corriger une macro qui ne fonctionne pas - svp

[Lune999]

Bonjour à tous,

Alors voilà mon soucis,

J'essaye de faire une macro qui :

- Efface Sheets("Feuil1").Range("B1") et Range("B4") si Sheet("Feuil1").Range("B4") = "no"
- S'active si Sheet("Feuil1").Range("B4") = "yes"
- Si "yes", alors, trouve la l'adresse de Sheets("Feuil1").Range("B1") dans l'intégralité du classeur (sauf Feuil1)
- Reporte la date d'aujourd'hui dans une des cellules vides à côté de la cellule de la valeur cherchée dans le classeur

Hors cela me met la valeur sur la 10e ligne à chaque fois ; Pourriez-vous svp m'aider à résoudre mon problème ?
Je débute un peu dans VBA et je ne comprends pas d'où vient mon erreur...

Merci d'avance de votre aide
Très bonne journée à tous !

----------------------------------------------------------------------------------------

Sub Worksheet_Change(ByVal Target As Range)

Dim sWk As Worksheet
Dim rCel As Range, c As Range
Dim j As Integer

x = Sheets("Feuil1").Range("B4").Value

Select Case x
Case Is = "no"
MsgBox "Action Annulée"
Sheets("Feuil1").Range("B4") = Empty 'Vide la cellule d'activation
Sheets("Feuil1").Range("B1") = Empty 'Vide la cellule de recherche
Application.Goto Reference:=Worksheets("Feuil1").Range("B1") 'Sélectionne la cellule de recherche
Exit Sub

Case Is = "yes"

sFlag = Sheets("Feuil1").Range("B1").Value

For Each sWk In ThisWorkbook.Worksheets
If sWk.Name <> "Feuil1" Then
iRow = sWk.Range("A" & Rows.Count).End(xlUp).Row
Set rCel = sWk.Range("A1:A" & iRow).Find(sFlag, LookIn:=xlValues, lookat:=xlWhole)
If Not rCel Is Nothing Then
iLig = rCel.Row

For j = 2 To 10
If sWk.Cells(iRow, j).Value = "" Then Exit For
Next
sWk.Cells(iRow, j).Value = Format(Now, "dd/mm/yyyy")

MsgBox "Action OK"
Sheets("Feuil1").Range("B4") = Empty 'Vide la cellule d'activation
Sheets("Feuil1").Range("B1") = Empty 'Vide la cellule de recherche
Application.Goto Reference:=Worksheets("Feuil1").Range("B1")
Exit Sub


End If

End If

Next


Application.EnableEvents = True

End Select

End Sub

 

[Lune999]

Bon en fait j'ai trouvé mon erreur... J'ai oublié que dans mon code iRow n'était psa égal à iLig.

Désolée pour ceux qui auront commencé à travaillé sur mon problème ; et je vous remercie tout de même de votre intérêt

Très bon après-midi à tous !

 

[ThierryP]

Bonjour Lune999,

Dans la ligne

sWk.Cells(iRow, j).Value = Format(Now, "dd/mm/yyyy")

tu fais appel à iRow, qui te renvoie la dernière ligne non vide de la colonne A, donc 10. A remplacer par iLig, défini comme rCel.row.

Egalement, comme tu utilises un évènement feuille, il faut penser à désactiver les évènements avant le traitement, car comme tu modifies une cellule de Feuil1, eh bien tu relances l'évènement "Worksheet_Change".

Sous les déclarations, ajoute :

Dim sWk As Worksheet
Dim rCel As Range, c As Range
Dim j As Integer
If Not Intersect(Range("B4"), Target) Is Nothing Then '#########
    Application.EnableEvents = False '#########
    x = Sheets("Feuil1").Range("B4").Value
    Select Case x
    Case Is = "no"
        MsgBox "Action Annulée"
        Sheets("Feuil1").Range("B4") = Empty 'Vide la cellule d'activation
        Sheets("Feuil1").Range("B1") = Empty 'Vide la cellule de recherche
        Worksheets("Feuil1").Range("B1").Select 'Sélectionne la cellule de recherche
        GoTo fin '#########
    Case Is = "yes"
         sFlag = Sheets("Feuil1").Range("B1").Value
         For Each sWk In ThisWorkbook.Worksheets
            If sWk.Name <> "Feuil1" Then
                iRow = sWk.Range("A" & Rows.Count).End(xlUp).Row
                Set rCel = sWk.Range("A1:A" & iRow).Find(sFlag, LookIn:=xlValues, lookat:=xlWhole)
                If Not rCel Is Nothing Then
                    iLig = rCel.Row
                    For j = 2 To 3
                        If sWk.Cells(iRow, j).Value = "" Then Exit For
                    Next
                    sWk.Cells(iLig, j).Value = Format(Now, "dd/mm/yyyy")
                    MsgBox "Action OK"
                    Sheets("Feuil1").Range("B4") = Empty 'Vide la cellule d'activation
                    Sheets("Feuil1").Range("B1") = Empty 'Vide la cellule de recherche
                    Worksheets("Feuil1").Range("B1").Select
                    GoTo fin '#########
                End If
            End If
        Next
    End Select
End If
fin: '#########
Application.EnableEvents = True '#########

ThierryP