XL 2016 vba excel

abdallah12 · 27 Mai 2021

salut les amis je sollicite votre aide
j'ai crée avec VBA un macro qui ajoute des feuilles puis les renommer selon les noms qui se trouve dans les cellules de la colonne "A" de ma feuille base, meme quand j'ajoute un nom dans la meme colonne il l'attribue a une nouvelle feuille qu'il crée automatiquement. pour éviter le message derreur "ce nom est deja attribué" j'ai mis dans le code " if target.column = "" then exit sub" et quand je clique sur une cellule vide pas de message d'erreure. du coup quand je saisi un nouveau nom il ne suffit plus de valider avec la touche "entrer" pour avoir une nouvelle feuille mais il faut que je clique a nouveau sur la cellule precedente. en plus si je clique sur une des cellules non vide de cette meme colonne ce meme message "ce nom est deja attribué" s'affiche a nouveau.

Merci d'avance

job75 · 27 Mai 2021

Bonjour abdallah12, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$, a
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---liste sans doublon des noms en colonne A---
tablo = UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    x = Trim(CStr(tablo(i, 1)))
    If x <> "" Then d(x) = ""
Next i
'---suppression des feuilles non inscrites en colonne A---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
    x =...

job75 · 27 Mai 2021

Bonjour abdallah12, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$, a
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---liste sans doublon des noms en colonne A---
tablo = UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    x = Trim(CStr(tablo(i, 1)))
    If x <> "" Then d(x) = ""
Next i
'---suppression des feuilles non inscrites en colonne A---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
    x = Sheets(i).Name
    If LCase(x) <> "accueil" Then
        If d.exists(x) Then
            d.Remove x 'retire de la liste
        Else
            Sheets(i).Delete 'supprime la feuille
        End If
    End If
Next i
If d.Count = 0 Then Exit Sub
'---création des feuilles---
a = d.keys
For i = 0 To UBound(a)
    If LCase(a(i)) <> "accueil" Then
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = a(i)
    End If
Next i
Sheets("Accueil").Activate
End Sub

Elle se déclenche quand on ajoute ou supprime un texte en colonne A.

A+

abdallah12 · 27 Mai 2021

job75 à dit:

Bonjour abdallah12, bienvenue sur XLD,

Voyez le fichier joint et cette macro dans le code de la feuille (clic droit sur l'onglet et Visualiser le code) :

VB:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, tablo, i&, x$, a
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
'---liste sans doublon des noms en colonne A---
tablo = UsedRange.Columns(1).Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
For i = 2 To UBound(tablo)
    x = Trim(CStr(tablo(i, 1)))
    If x <> "" Then d(x) = ""
Next i
'---suppression des feuilles non inscrites en colonne A---
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For i = Sheets.Count To 1 Step -1
    x = Sheets(i).Name
    If LCase(x) <> "accueil" Then
        If d.exists(x) Then
            d.Remove x 'retire de la liste
        Else
            Sheets(i).Delete 'supprime la feuille
        End If
    End If
Next i
If d.Count = 0 Then Exit Sub
'---création des feuilles---
a = d.keys
For i = 0 To UBound(a)
    If LCase(a(i)) <> "accueil" Then
        Sheets.Add After:=Sheets(Sheets.Count)
        ActiveSheet.Name = a(i)
    End If
Next i
Sheets("Accueil").Activate
End Sub

Elle se déclenche quand on ajoute ou supprime un texte en colonne A.

A+

Vraiment Merci beaucoup j'avoue que "merci" ne suffit pas pour cette beauté mais malheureusement je n'ai que ça à offrir. Je suis vraiment content
C'est vraiment impeccable
Merci encore

XL 2016 vba excel

abdallah12

XLDnaute Nouveau

job75

job75

XLDnaute Barbatruc

Pièces jointes

abdallah12

XLDnaute Nouveau

Discussions similaires