hoe code aanpassen

[davylenders123]

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim iWS As Integer
    On Error Resume Next
    If ActiveSheet.Index <= 3 And Target.Row > 33 Then
        For iWS = 1 To 3
            Worksheets(iWS).Range("A3:G33").Find(Target, , xlValues, xlWhole).Value = ""
        Next
    End If
End Sub

Deze code gaat zoeken in 3 tab bladen naar de zelfde naam dan je hebt ingegeven in een cel onder rij 33.
Als hij die vind dan verwijderd hij die uit de cellen a3:g33.

Als een naam 2 keer voor komt op het zelfde tab blad verwijderd hij er echter maar 1 van.

Hoe moet de code worden aangepast zodat hij de 2 de zelfde namen verwijderd op het zelfde tab blad

 

[HSV]

Probeer het zo eens.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i, j, iWS As Integer
  For i = 3 To 33
  For j = 1 To 7
    On Error Resume Next
    If ActiveSheet.Index <= 3 And Target.Row > 33 Then
        For iWS = 1 To 3
            Worksheets(iWS).Cells(i, j).Find(Target, , xlValues, xlWhole).Value = ""
        Next
      End If
    Next j
  Next i
End Sub

 

[davylenders123]

Harry bedankt het werkt :thumb: