Bug suppréssion de noms colonne A

Bonjour

J'ai un bug dans ce code

Si je supprime un nom en colonne A pas de problème ,si je fais un RAZ bug sur la ligne signalée en rouge

Comment rectifier ce hic?

Merci pour votre aide

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Dim c As Integer

Dim Ws As Worksheet

Dim Plage As Range

Dim Prenom

Application.ScreenUpdating = False

If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then

If Target.Value = "" Then Exit Sub

'Boucle sur les feuilles du classeur.

For Each Ws In ThisWorkbook.Worksheets

If Ws.Name = Target.Value Then 'même nom

MsgBox "Une feuille existe dèjà à ce nom!", vbExclamation, "Ajout feuille"

Exit Sub

End If

Next Ws

'---------------Copie modele en dernier--------------------

With Sheets("Modele")

.Select

.Range("D1") = Target.Value

.Copy After:=Sheets(Sheets.Count)

.Range("D1") = ""

End With

' renomme cette feuille avec le nom

Sheets(Sheets.Count).Name = Target.Value

'-----------------------------------------------

End If

Sheets("BDD").Activate

fin:

Application.ScreenUpdating = True

End Sub

Bonjour,

Erreur classique !

Target est une plage de cellules (parfois une cellule unique mais pas toujours)

Ajoutes en début de procédure :

  If Target.Count > 1 Then Exit Sub

Et sinon il faut traiter chaque cellule de Target (For Each cel in Target.cells)

Merci Patrice pour ta solution

Problème résolu

Cordialement