Sujet Précédent Sujet Suivant

[VB.Excel] Supprimer feuilles inactives

Résolu/Fermé
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021 - Modifié le 27 mai 2018 à 19:39
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021 - 1 juin 2018 à 01:01
bonjour,

J'ai un dossier (consolider) qui comporte que des fichier Excel
Mon bute est de supprimer toutes les feuilles inactive de toutes les classeur qui se trouve dans mon dossier (consolider).

ici bas mon code VB, vu que je suis débutant malheureusement ça marche plus

merci d'avance pour vos aides 

 Option Explicit
Dim NomClasseur As String
Dim WS As Worksheet

Sub SupWS()

ChDir "C:\Users\User\Desktop\consolider"

NomClasseur = Dir("C:\Users\User\Desktop\consolider\*.xlsx")

While Len(NomClasseur) > 0
    Workbooks.Open NomClasseur
    
        For Each WS In ThisWorkbook.Worksheets
            If WS.Name <> ThisWorkbook.ActiveSheet.Name Then
                Application.DisplayAlerts = False
                WS.Delete
                Application.DisplayAlerts = True
            End If
        Next WS
    
    Workbooks(NomClasseur).Save
    Workbooks(NomClasseur).Close
    NomClasseur = Dir

Wend

MsgBox "le traitement est terminer..."

End Sub


EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.
A voir également:

2 réponses

Réponse 1 / 2
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
27 mai 2018 à 19:15
Bonjour,

Cette feuille active est la meme dans tous les clsseurs????
0
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021
28 mai 2018 à 00:47
Bonjour,

Non, la feuille active n'est pas la même, et merci boucoup pour votre aide.
0
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
28 mai 2018 à 08:36
Bonjour,

Qu'est ce qui ne marche plus, que ce passe-t-il??
0
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021
28 mai 2018 à 19:15
Bonjour,

En effet j'arrive pas à atteindre mon objectif, à savoir supprimer les feuilles inactives de toutes les classeurs.

Les modifications s'appliquent sur mon fichier (.xlsm) et non pas aux autres classeurs (.xlsx), qui s'ouvrent et se ferment sants modifications.

Merci d'avance pour votre aide.
0
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
29 mai 2018 à 06:47
Bonjour,

C'est 
ThisWorkbook
qui fait que vous supprimez dans le classeur xlsm
0
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021
29 mai 2018 à 19:31
Bonjour,

Que devrons nous faire à la place de Thisworbook? et merci d'avance.
0
Réponse 2 / 2
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
30 mai 2018 à 08:32
Bonjour,

un exemple de code avec recherche chemin du Bureau 

Sub Sup_WS()
    Dim Date_in As String, Date_Choix As Date
    Dim Fichier As String, Chemin_Bureau As String, MsgGP As String, TitleMsg As String
    
    Application.ScreenUpdating = False      'fige ecran
    'recherche du chemin du Bureau
    Chemin_Bureau = ObtenirCheminBureau() & "\consolider\"
    'recherche fichiers
    NbF = 0
    NomClasseur = Dir(Chemin_Bureau & "*.xlsx")
    'Boucle sur les fichiers
    While NomClasseur <> ""
        Call Traitement(Chemin_Bureau & NomClasseur, NomClasseur)
        NbF = NbF + 1
        NomClasseur = Dir()     'fichier suivant
    Wend
    
            MsgBox "[ " & NbF & " ] Fichier(s) recupere(s)"
    
    Application.ScreenUpdating = True   'defige ecran
End Sub

'Traitement suppression feuilles
Sub Traitement(Chemin_Bureau_Fichier, Fichier)
    Dim WS As Worksheet
    
    Workbooks.Open Chemin_Bureau_Fichier
        For Each WS In Worksheets
            If WS.Name <> ActiveSheet.Name Then
                Application.DisplayAlerts = False
                WS.Delete
                Application.DisplayAlerts = True
            End If
        Next WS
    Workbooks(Fichier).Close True
End Sub
0
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021
30 mai 2018 à 21:14
bonjour,

Problème résolu. Merci pour toutes tes éclaircissement, résultats étonnants.

juste pour info, au début j'ai un petit problème de débogage avec votre Code, mais j'ai remplacer votre instruction n°7 par: ChDir "C:\Users\User\Desktop\consolider" et c'est parfait.
0
f894009 Messages postés 17206 Date d'inscription dimanche 25 novembre 2007 Statut Membre Dernière intervention 22 novembre 2024 1 710
31 mai 2018 à 06:56
Bonjour,

C'est moi qui ai merde, j'ai oublie la fonction recherche bureau 

Public Function ObtenirCheminBureau() As String
'par: Excel-Malin.com ( http://excel-malin.com )

    On Error GoTo ObtenirCheminBureauError
    Dim CheminBureau As String
    CheminBureau = ""
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    
    CheminBureau = oWSHShell.SpecialFolders("Desktop")
    
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = CheminBureau

    Exit Function
ObtenirCheminBureauError:
    If (Not (oWSHShell Is Nothing)) Then Set oWSHShell = Nothing
    ObtenirCheminBureau = ""
End Function
0
ProMed1 Messages postés 30 Date d'inscription dimanche 27 mai 2018 Statut Membre Dernière intervention 13 avril 2021
1 juin 2018 à 01:01
bonjour,

OK bien reçu, merci beaucoup.
0