Suppression des nom dans une colonne Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
J
Joco7915
Membre habitué
Membre habitué
Messages : 101
Appréciations reçues : 3
Inscrit le : 31 octobre 2019
Version d'Excel : 2019
Version de Sheets : FR

Message par Joco7915 » 14 mars 2020, 16:20

Re bonjour

Comment pratiquer pour faire une RAZ de noms dans colonne A et en même temps supprimer les feuilles
correspondantes à ces noms.
Je cherche par macro mais je trouve pas la solution
Cordialement
g
gmb
Fanatique d'Excel
Fanatique d'Excel
Messages : 13'055
Appréciations reçues : 388
Inscrit le : 4 avril 2013
Version d'Excel : 2016

Message par gmb » 14 mars 2020, 16:26

Bonjour
Joco7915 a écrit :
14 mars 2020, 16:20
et en même temps supprimer les feuilles
correspondantes à ces noms.
Il faudrait savoir comment ces noms correspondent avec les noms des feuilles...
En expliquant ça avec un fichier joint peut-être ?
Bye !
J
Joco7915
Membre habitué
Membre habitué
Messages : 101
Appréciations reçues : 3
Inscrit le : 31 octobre 2019
Version d'Excel : 2019
Version de Sheets : FR

Message par Joco7915 » 14 mars 2020, 16:32

Bonjour
Merci pour ton aide
Ci-dessous le code qui fait le travail

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
Dim Ws As Worksheet
Dim Plage As Range
Dim Nom
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Count > 1 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
Avatar du membre
Patrice33740
Membre dévoué
Membre dévoué
Messages : 662
Appréciations reçues : 60
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2016
Version de Calc : LO 6.3.5 fr

Message par Patrice33740 » 14 mars 2020, 16:34

Bonjour,

Peut-être comme ça (dans le module de la feuille avec les noms) :
Option Explicit
Sub RazEtSupprimeFeuille()
Dim wsh As Worksheet
Dim rng As Range
Dim cel As Range
  Set rng = Intersect(Me.UsedRange, Me.Columns(1))
  If Not rng Is Nothing Then
    For Each cel In rng.Cells
      On Error Resume Next
      Set wsh = Worksheets(cel.Text)
      On Error GoTo 0
      If Not wsh Is Nothing Then
        Application.DisplayAlerts = False
        wsh.Delete
        Application.DisplayAlerts = True
      End If
      Set wsh = Nothing
    Next cel
    rng.ClearContents
  End If
End Sub
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
J
Joco7915
Membre habitué
Membre habitué
Messages : 101
Appréciations reçues : 3
Inscrit le : 31 octobre 2019
Version d'Excel : 2019
Version de Sheets : FR

Message par Joco7915 » 14 mars 2020, 16:38

Aprés essai
erreur de compilation sur le Me avant UsedRange
Set rng = Intersect(Me.UsedRange, Me.Columns(1))
Avatar du membre
Patrice33740
Membre dévoué
Membre dévoué
Messages : 662
Appréciations reçues : 60
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2016
Version de Calc : LO 6.3.5 fr

Message par Patrice33740 » 14 mars 2020, 17:08

Patrice33740 a écrit :
14 mars 2020, 16:34
Peut-être comme ça (dans le module de la feuille avec les noms) :
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
J
Joco7915
Membre habitué
Membre habitué
Messages : 101
Appréciations reçues : 3
Inscrit le : 31 octobre 2019
Version d'Excel : 2019
Version de Sheets : FR

Message par Joco7915 » 14 mars 2020, 17:11

Re bonjour Patrice
Ci-dessous photo du bug
Me.jpg
J
Joco7915
Membre habitué
Membre habitué
Messages : 101
Appréciations reçues : 3
Inscrit le : 31 octobre 2019
Version d'Excel : 2019
Version de Sheets : FR

Message par Joco7915 » 14 mars 2020, 17:15

Avec le code dans le module de la feuille,ça supprime les feuilles mais pas les noms dans la colonneA
Avatar du membre
Patrice33740
Membre dévoué
Membre dévoué
Messages : 662
Appréciations reçues : 60
Inscrit le : 27 juillet 2014
Version d'Excel : FR, 2007, 2003, 2016
Version de Calc : LO 6.3.5 fr

Message par Patrice33740 » 14 mars 2020, 17:33

Tu as oublié le rng.ClearContents après le Next cel
Cordialement
Patrice

Personne ne peut détenir le savoir, c'est pour ça qu'on le partage.
J
Joco7915
Membre habitué
Membre habitué
Messages : 101
Appréciations reçues : 3
Inscrit le : 31 octobre 2019
Version d'Excel : 2019
Version de Sheets : FR

Message par Joco7915 » 15 mars 2020, 14:26

Bonjour
me revoilà de retour avec un problème quand j'utilise la macro Razetsupprimefeuille
j'ai un rond rouge avec une croix blanche et 400
ou se trouve l'erreur sachant que les noms que je veux supprimer se trouvent en colonne A à partir de A3 la suppression des feuilles fonctionnent très bien.
Dans les codes suivants

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
Dim Ws As Worksheet
Dim Plage As Range
Dim Nom
Application.ScreenUpdating = False
If Not Application.Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Count > 1 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("A1") = Target.Value
.Copy After:=Sheets(Sheets.Count)
.Range("A1") = ""
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




Sub RazEtSupprimeFeuille()
Dim wsh As Worksheet
Dim rng As Range
Dim cel As Range
Set rng = Intersect(Me.UsedRange, Me.Columns(1))
If Not rng Is Nothing Then
For Each cel In rng.Cells
On Error Resume Next
Set wsh = Worksheets(cel.Text)
On Error GoTo 0
If Not wsh Is Nothing Then
Application.DisplayAlerts = False
wsh.Delete
Application.DisplayAlerts = True
End If
Set wsh = Nothing
Next cel
rng.ClearContents
End If
End Sub
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message