Supprimer plusieurs onglet sauf 3 ?

Anonyme
2016-07-09T12:56:00+00:00

Bonjour à tous,

Je viens vers vous car j'ai besoin d'un petit coup de pouce..... J'ai un code qui me permet de créer des onglets selon les données d'une colonne. Jusque là pas de problème. Auparavant dans mon classeur, j'avais un onglet nommé "base", et lorsque j'active ma macro, toutes les feuilles sont supprimées sauf la feuilles "base".

Mais aujourd'hui, je voudrais que non seulement la feuille "base" ne soit pas supprimé, mais également 2 autres nommées "JD" et "RELANCE". Je ne sais comment modifier mon code ?

Si quelqu'un pouvait m'aider à le faire ce serait plus que sympa.

Merci aux personnes qui prendront le soin de m'aider.

Sandrine

Voici  mon code :

Sub Creation()

Dim Sh As Object, cel As Range

Application.ScreenUpdating = False

For Each Sh In Sheets

    If Sh.Name <> "base" Then

        Application.DisplayAlerts = False

        Sh.Delete

    End If

Next Sh

Range("I2:I" & [I65000].End(xlUp).Row).Name = "LOT"

Range("A2:Y" & [I65000].End(xlUp).Row).Name = "mabase"

[AK2] = [I2]

    Range("LOT").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _

        "AK2"), Unique:=True

For Each cel In Range("AK3:AK" & [AK65000].End(xlUp).Row)

    Sheets("base").[AK3] = cel

    Sheets.Add after:=Sheets(Sheets.Count)

    With ActiveSheet

        .Name = " " & cel

        .[A2:Y2] = Sheets("base").[A2:Y2]

        Range("mabase").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets( _

        "base").Range("AK2:AK3"), CopyToRange:=.Range("A2:Y2"), Unique:=False

    End With

Next cel

Call MEF

End Sub

Microsoft 365 et Office | Excel | Pour la maison | Windows

Question verrouillée. Cette question a été migrée à partir de la Communauté Support Microsoft. Vous pouvez voter pour indiquer si elle est utile, mais vous ne pouvez pas ajouter de commentaires ou de réponses ni suivre la question.

0 commentaires
Réponse acceptée par l’auteur de la question
DanielCo 107.1K Points de réputation
2016-07-11T12:35:09+00:00

Essaie :

Private Sub CommandButton1_Click()

' Modifier

Dim Ctrl As Control

Dim Colonne As Integer

Dim Ligne As Long

  If Me.ComboBox5.ListIndex = -1 And Me.CODE.ListIndex = -1 And Me.Ndemande.ListIndex = -1 Then Exit Sub

  If Me.ComboBox5.ListIndex > -1 Then

    Ligne = Me.ComboBox5.ListIndex + 2

  ElseIf Me.CODE.ListIndex > -1 Then

    Ligne = Me.CODE.ListIndex + 2

  ElseIf Me.Ndemande.ListIndex > -1 Then

    Ligne = Me.Ndemande.ListIndex + 2

  End If

  With Sheets("base")

    For Each Ctrl In Me.Controls

      Colonne = Val(Ctrl.Tag)

      If Colonne > 0 Then .Cells(Ligne, Colonne) = Ctrl

    Next Ctrl

  End With

  Unload Me

    UserForm2.Show

End Sub

Daniel

Cette réponse a-t-elle été utile ?

0 commentaires

26 réponses supplémentaires

Trier par : Le plus utile
Le plus utile Les plus récents Les plus anciens
  1. Anonyme
    2016-07-10T05:55:08+00:00

    Bonjour,

    Bon à connaître quand même pour ce genre de cas le Select Case

    Dim sh As Worksheet

    Application.DisplayAlerts = False

        For Each sh In ThisWorkbook.Sheets

            Select Case sh.Name

            Case "Base", "JD", "RELANCE"

            'on ne fait rien

            Case Else

            sh.Delete

            End Select

        Next sh

    Application.DisplayAlerts = true

    'LSteph

    Cette réponse a-t-elle été utile ?

    0 commentaires
  2. DanielCo 107.1K Points de réputation
    2016-07-09T13:28:39+00:00

    J'ai défini un array avec les noms des feuilles à ne pas supprimer et à chaque feuille je fais l'équivalent de la fonction Excel EQUIV. Si la feuille ne fais pas partie de la liste je la supprime.

    Daniel

    Cette réponse a-t-elle été utile ?

    0 commentaires
  3. Anonyme
    2016-07-09T13:22:01+00:00

    Bonjour Daniel,

    C'est trop génial !!!!

    J'ai pas encore le reflex, mais c'est vrai en nommant mes feuilles "F" par exemple, c'est plus limpide....

    J'ai bien compris, c'est ce que tu as fait ?

    En tout cas, mille fois merci pour ton aide rapide et précieuse.

    Bien cordialement,

    Sandrine

    Cette réponse a-t-elle été utile ?

    0 commentaires
  4. DanielCo 107.1K Points de réputation
    2016-07-09T13:06:17+00:00

    Bonjour,

    Sub Creation()

    Dim Sh As Object, cel As Range, F As Variant

    F = Array("base", "JD", "RELANCE")

    Application.ScreenUpdating = False

    For Each Sh In Sheets

        If Not IsNumeric(Application.Match(Sh.Name, F, 0)) Then

            Application.DisplayAlerts = False

            Sh.Delete

        End If

    Next Sh

    Range("I2:I" & [I65000].End(xlUp).Row).Name = "LOT"

    Range("A2:Y" & [I65000].End(xlUp).Row).Name = "mabase"

    [AK2] = [I2]

        Range("LOT").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _

            "AK2"), Unique:=True

    For Each cel In Range("AK3:AK" & [AK65000].End(xlUp).Row)

        Sheets("base").[AK3] = cel

        Sheets.Add after:=Sheets(Sheets.Count)

        With ActiveSheet

            .Name = " " & cel

            .[A2:Y2] = Sheets("base").[A2:Y2]

            Range("mabase").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets( _

            "base").Range("AK2:AK3"), CopyToRange:=.Range("A2:Y2"), Unique:=False

        End With

    Next cel

    Call MEF

    End Sub

    Cordialement.

    Daniel

    Cette réponse a-t-elle été utile ?

    0 commentaires