Discussion :

[Krovax]

Ouskel'n'or
ta donné le code pour supprimer une feuille vierge

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

if worksheets("feuil3").usedrange.address = "$A$1" and worksheets("feuil3").range("$a$1") = "" then Msgbox "La feuille est vide !"

(légèrement modifié pour te simplifier les choses)
remplace la mesage box par la suppression de la feuille
je te donne pour boucler sur toutes les feuille du classeur

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 Dim ws As Worksheet
For Each ws In Worksheets
MsgBox ws.Name & chr(13) & "La première cellule contient " & ws.range("A1")
Next ws

Remplace le message box par le code de ouskel'n'or en utilisant ws pour désigner la feuille

[FCL31]

J'ai fais

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, derlig As Long, WS As Worksheet
For Each LaFeuille In CL2.Worksheets
 LaFeuille.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
        End If
    Next LaFeuille
 
For Each WS In Worksheets
If Worksheets(WS).UsedRange.Address = "$A$1" And Worksheets(WS).Range("$a$1") = "" Then Sheets(WS).Delete
 Next WS
 
End Sub

Sa marche pas (peut être j'ai mal fait)
Sa me surligne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If Worksheets(WS).UsedRange.Address = "$A$1" And Worksheets(WS).Range("$a$1") = "" Then

en jaune

Il me semble pourtant avoir bien fait

.

[ouskel'n'or]

Tu déclares bien Ws as worksheet ?
Oui !
Donc Ws correspond dans ta boucle à l'objet worksheet du classeur actif. Tel que c'est écrit !
Donc, si tu mets Worksheets(Ws) c'est comme si tu mettais "Worksheets(Worksheets(in workbook))" Et ça, ça marche pas !
D'où ma question : Pourquoi t'arranges-tu toujours pour changer ce qui fonctionne dans le code qu'on te propose ?
Mets donc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If ws.UsedRange.Address = ...

c'est très suffisant !

[Krovax]

Et pourtant j'avais exprès édité mon message pour te mettre l'exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ws.range("A1")

Dit toi que quand tu tape

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

sheets("Feuil1")

les " signifie que c'est une chaine de caractère ws n'est pas une chaine de caractère, ws est la feuille

[FCL31]

Ok c'est cool sa a l'air de marcher

A force on y est arrivé

Il suffisait juste de m'expliquer

En tout cas merci

Si j'ai un problème je reviens vous voir




Je vous met quand même le code que j'ai au final (sa peu aider)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
Public msg As String
 Sub Appel() 'A ADAPTER
Dim Chemin As String
    Application.ScreenUpdating = False
        Chemin = Recherche.TextBox1.Text
        Ouvrir Chemin
            Application.ScreenUpdating = True
    If msg <> "" Then _
    MsgBox "Pour des raisons de protection ou autres, n'ont pu être copiées " & vbCrLf & msg
End Sub
Sub Ouvrir(Chemin As String)
Dim NomFich As String
Dim CL2 As Workbook 'fichier copié
    Application.DisplayAlerts = False 'Evite les messages d'Excel
    'Evite l'exécution éventuelle de macros liées aux fichiers ouverts
    Application.EnableEvents = False
        NomFich = Dir(Chemin & "*.xls")
        If NomFich = "" Then
             MsgBox "Aucun fichier trouvé dans " & Chemin
             Exit Sub
        End If
        Do While NomFich <> ""
            Set CL2 = Workbooks.Open(Chemin & NomFich)
            DoEvents
            Copie CL2
            CL2.Close False
            DoEvents
            ThisWorkbook.Save 'enregistrement du classeur après chaque copie
            DoEvents
            NomFich = Dir
        Loop
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub
Sub Copie(CL2 As Workbook)
Dim LaFeuille As Worksheet, derlig As Long, WS As Worksheet
For Each LaFeuille In CL2.Worksheets
 LaFeuille.Copy After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count)
            DoEvents
            If Err <> 0 Then
                msg = msg & "Classeur " & NomFich & " feuille " & LaFeuile.Name & vbCrLf
                On Error GoTo 0
        End If
    Next LaFeuille
For Each WS In Worksheets
If WS.UsedRange.Address = "$A$1" And WS.Range("$a$1") = "" Then WS.Delete
Next WS
End Sub

Il y a peut-être plus simple mais sa a l'air de bien marcher

[ouskel'n'or]

Si j'ai un problème je reviens vous voir

Ça va pas, non ?