Supprimer les onglets sauf le premier

[RVL]

Bonjour au Forum,

J'aimerai savoir si il y a possibilité avec une macro, d'effacer l'ensemble des onglets d'un fichier, sauf le premier à gauche.

Je n'y arrive pas avec l'editeur de macro.

 

[Pierrot93]

Re : Supprimer les onglets sauf le premier

Bonjour,

essaye ceci :

Dim i As Byte
Application.DisplayAlerts = False
For i = 2 To Sheets.Count
    Sheets(i).Delete
Next i
Application.DisplayAlerts = True

bon après midi
@+

 

[James007]

Re : Supprimer les onglets sauf le premier

Bonjour,

Tu peux, en te placant dans la seule feuille que tu veux conserver, lancer cette macro :

Sub SupprimerOnglets()
Application.Displayalerts = False
For Each sh In Activeworkbook.Worksheets 
    If sh.Name <> activesheet.name then 
        sh.Delete 
    End If 
Next sh
Application.Displayalerts = True 
End Sub

A +


Edit : Salut Pierrot93

 

[Efgé]

Re : Supprimer les onglets sauf le premier

Bonjour à tous,
Une autre version que l'on peux lancer de n'importe où et même si des feuilles ont déjas été supprimées.

Sub Supr_Feuilles()
Dim i As Integer
Application.DisplayAlerts = False
For i = Sheets.Count To 2 Step -1
     If Sheets(i).Index = i Then Sheets(i).Delete
Next i
Application.DisplayAlerts = True
End Sub

Cordialement

 

[Pierrot93]

Re : Supprimer les onglets sauf le premier

Re,

Aarf, effectivement fg, il faut commencé par la fin... mon code bogue....

 

[RVL]

Re : Supprimer les onglets sauf le premier

OK ça marche, un grand merci à vous 3.

Je "boguais" egalement avec le code de Pierrot et je n'avais pas vu la version d'Efgé

A+

 

[Efgé]

Re : Supprimer les onglets sauf le premier

Bonjour à tous, le fil, le forum
Comme ma proposition me parrait un peu tarabiscotée, je reviens dessus :

Sub Suppr_Feuilles2()
Dim F As Worksheet
Application.DisplayAlerts = False
For Each F In Worksheets
    If F.Index <> 1 Then F.Delete
Next F
Application.DisplayAlerts = True
End Sub

Cordialement

 

[James007]

Re : Supprimer les onglets sauf le premier

Bonjour à tous, Salut Efgé

Je ne te cacherai pas que comme, dans l'esprit des gens, le concept d'Index se confond trop souvent avec celui de Name, j'en suis arrivé à dire de placer son curseur dans la seule feuille que l'on souhaite conserver, avant lancer la macro de suppression de tous les autres onglets ...

A +

 

[job75]

Re : Supprimer les onglets sauf le premier

Bonjour le fil, le forum,

Avec cette macro (dans un module ou dans la 1ère feuille) on supprime tout d'un coup :

Sub Supprime()
Dim Liste(), i
ReDim Liste(1 To Sheets.Count - 1)
For i = 1 To UBound(Liste)
  Liste(i) = Sheets(i + 1).Name
Next
Application.DisplayAlerts = False
Sheets(Liste).Delete
End Sub

A+

 

[job75]

Re : Supprimer les onglets sauf le premier

Re,

Ah mais on peut même se passer des noms de feuilles (je découvre)...

Sub Supprime()
Dim Liste(), i
ReDim Liste(1 To Sheets.Count - 1)
For i = 1 To UBound(Liste)
  Liste(i) = i + 1 'liste des index
Next
Application.DisplayAlerts = False
Sheets(Liste).Delete
End Sub

A+

 

[job75]

Re : Supprimer les onglets sauf le premier

Bonsoir le fil,

Juste pour montrer à JB que ses leçons servent à quelque chose :

Sub Supprime()
Dim Liste As Object, i
Set Liste = CreateObject("Scripting.Dictionary")
For i = 2 To Sheets.Count
  Liste(i) = i 'liste des index
Next
Application.DisplayAlerts = False
On Error Resume Next 's'il n'y a plus qu'une feuille...
Sheets(Liste.Items).Delete
End Sub

A+

 

[James007]

Re : Supprimer les onglets sauf le premier

Bonjour le fil

Super job ... Job75

Grâce à toi, ce fil va devenir " Collector "

A +

 

[MJ13]

Re : Supprimer les onglets sauf le premier

Bonjour à tous

Comme c'est un collector , voici 3 macros qui me servent pour mon planning pour afficher, masquer, supprimer toutes ou partie des feuilles et remettre dans le bon ordre celles qu'on veut .

Sub A_Supprime_Feuilles_Inutiles()
Stop
Msgbox "attention les feuilles vont être supprimées (faire ctrl+pause pour arrêter)!"
Dim NOMFeuilleAgarder(100)
NOMFeuilleAgarder(1) = "Trouve"
NOMFeuilleAgarder(2) = "Scan sur"
NOMFeuilleAgarder(3) = "Param"
NOMFeuilleAgarder(4) = "BO"
'Sheets("Feuil3").Move After:=Sheets(4)
'delBO
ThisWorkbook.Activate
NF = ThisWorkbook.Sheets.Count
Sheets(NOMFeuilleAgarder(1)).Move After:=Sheets(NF)
Sheets(NOMFeuilleAgarder(2)).Move After:=Sheets(NF)
Sheets(NOMFeuilleAgarder(3)).Move After:=Sheets(NF)
Sheets(NOMFeuilleAgarder(4)).Move After:=Sheets(NF)
'Stop
For i = 1 To NF - 4'adapter sur le nombre de feuilles à garder
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
Next
Sheets(1).Activate
End Sub

Sub A_MAsque_Feuilles_Inutiles()
'Stop
On Error Resume Next
Dim NOMFeuilleAgarder(100)
NOMFeuilleAgarder(1) = "Planning2011"
'NOMFeuilleAgarder(2) = "Scan sur"
'NOMFeuilleAgarder(3) = "Param"
'NOMFeuilleAgarder(4) = "BO"
'Sheets("Feuil3").Move After:=Sheets(4)
'delBO
ThisWorkbook.Activate
'MsgBox ThisWorkbook.Name

NF = ThisWorkbook.Sheets.Count
Sheets(NOMFeuilleAgarder(1)).Move After:=Sheets(NF)
'Sheets(NOMFeuilleAgarder(2)).Move After:=Sheets(NF)
'Sheets(NOMFeuilleAgarder(3)).Move After:=Sheets(NF)
'Sheets(NOMFeuilleAgarder(4)).Move After:=Sheets(NF)
'Stop
For i = 1 To NF - 1'adapter sur le nombre de feuilles à garder
Application.DisplayAlerts = False
If Sheets(i).Visible = True Then Sheets(i).Visible = False
Application.DisplayAlerts = True
Next
Sheets(1).Activate
End Sub

Sub Affiche_Toutes_Feuilles()
Application.ScreenUpdating = False
nc = ActiveWorkbook.Sheets.Count
For n = 1 To nc
Sheets(n).Visible = True
Next
Application.ScreenUpdating = True
End Sub

 

[Pierrot93]

Re : Supprimer les onglets sauf le premier

Bonjour à tous,

Encore une autre approche, pour le fun....

Option Explicit
Sub test()
Dim ws As Worksheet
For Each ws In Worksheets
    ws.Select ws.Index <= 2
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
End Sub

bonne journée
@+

 

[MJ13]

Re : Supprimer les onglets sauf le premier

Bonjour à tous

En reprenant le dernier code de Pierrot , voici 2 codes complémentaires si on a des feuilles masquées pour supprimer tout sauf la première feuille (test) ou tout sauf la feuille sélectionnée (test2).

Sub test()
'Supprime_Feuilles sauf la feuille en première position
Application.ScreenUpdating = False
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next ws
For Each ws In Worksheets
ws.Select ws.Index <= 2
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Sub test2()
'supprime_Feuilles_sauf_celle_sélectionnée
Application.ScreenUpdating = False
'Stop
Position = ActiveSheet.Index
Dim ws As Worksheet
For Each ws In Worksheets
ws.Visible = True
Next ws
'Stop
Sheets(Position).Move before:=Sheets(1)
For Each ws In Worksheets
ws.Select ws.Index <= 2
Next ws
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub