[VB.Excel] Supprimer feuilles inactives

Résolu
ProMed1 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -  
ProMed1 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention   -
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 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Cette feuille active est la meme dans tous les clsseurs????
0
ProMed1 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Non, la feuille active n'est pas la même, et merci boucoup pour votre aide.
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

Qu'est ce qui ne marche plus, que ce passe-t-il??
0
ProMed1 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention  
 
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 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

C'est 
ThisWorkbook
qui fait que vous supprimez dans le classeur xlsm
0
ProMed1 Messages postés 30 Date d'inscription   Statut Membre Dernière intervention  
 
Bonjour,

Que devrons nous faire à la place de Thisworbook? et merci d'avance.
0
Réponse 2 / 2
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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   Statut Membre Dernière intervention  
 
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 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
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   Statut Membre Dernière intervention  
 
bonjour,

OK bien reçu, merci beaucoup.
0