Discussion :

[JukeBoX]

Bonjour,

J'ai une macro qui me permet d'ouvrir des classeurs dans un dossier suivant la valeur d'une cellule comme nom de référence et j'aimerai supprimer ces classeurs si à l'intérieur de ces classeurs une cellule est identique à une autre.

Voilà le code en question :

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
ReDim T(0 To 0)
Dim I As Long
Set CS = Workbooks("EXEMPLE")
Set OS = CS.Worksheets("TEST")
ScanFolder T, "U:\Public", OS.Range("D6").Value & "*.xls*", False
If Not IsEmpty(T(0)) Then
UserForm47.Show
For I = 0 To UBound(T)
Workbooks.Open T(I)
Worksheets(2).Activate
Set ma = Range("C6").MergeArea
If ma.Address = "$C$6:$D$6" And Range("C6").Value Like "*" & OS.Range("D8").Value & "*" Then
' supprimer le fichier
End If
Next I
Else
UserForm48.Show
End If

Avec la fonction Kill cela doit être possible ?

Merci d'avance !

[Philippe Tulliez]

Bonjour,

Avec la fonction Kill cela doit être possible ?

La réponse est oui mais il ne faut pas oublier de le fermer avant de le supprimer

[Qwazerty]

SAlut

Attention

Code :

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

1
2
 
If ma.Address = "$C$6:$D$6" And Range("C6").Value Like "*" & OS.Range("D8").Value & "*" Then

Le second range testé n'est pas rattaché explicitement à un worksheet, ça sera le range de la feuille active qui sera pris en compte.
Peut-être est-ce volontaire mais un conseil, il vaut mieux toujours spécifier explicitement sur quelle feuille on travaille... ça évite bien des entourloupes et des heures de recherche de bug.

++
Qwaz

[JukeBoX]

SAlut

Attention

Code :

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

1
2
 
If ma.Address = "$C$6:$D$6" And Range("C6").Value Like "*" & OS.Range("D8").Value & "*" Then

Le second range testé n'est pas rattaché explicitement à un worksheet, ça sera le range de la feuille active qui sera pris en compte.
Peut-être est-ce volontaire mais un conseil, il vaut mieux toujours spécifier explicitement sur quelle feuille on travaille... ça évite bien des entourloupes et des heures de recherche de bug.

++
Qwaz

Salut,

Oui c'est volontaire, je travaille avec la feuille active, si correspondance alors supprimer ce classeur.

[Qwazerty]

Salut

C'est toi qui vois, de mon coté je gérerais plutôt ça comme ça afin d'éviter les ennuis...
Un classeur qui bondi au 1er plan et que se retrouve tout massacré sans possibilité de retour en arrière... ça t'arrive une fois et après tu précises le classeur et la feuille sur laquelle tu veux travailler... Mais encore une fois, c'est toi qui vois

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
ReDim T(0 To 0)
Dim I As Long
Dim Classeur As String
Dim WbClient As Workbook
    On Error Resume Next
        Set CS = Workbooks("EXEMPLE")
        Set OS = CS.Worksheets("TEST")
    On Error GoTo 0
 
    'On s'assure que OS existe
    If Not OS Is Nothing Then
        'On scan le repertoire
        ScanFolder T, "U:\Public", OS.Range("D6").value & "*.xls*", False
        If Not IsEmpty(T(0)) Then
            'On ouvre le UF47 (un nom explicite serait plus pratique pour d'éventuellesfutures modifications(plus simple de s'y retrouver)
            UserForm47.Show
            'On boucle sur les noms de fichiers
            For I = 0 To UBound(T)
                'On pointe le fichier
                On Error Resume Next
                    Set WbClient = Workbooks.Open(T(I))
                On Error GoTo 0
                If Not WbClient Is Nothing Then
                    With WbClient
                        'On vérifie que la feuille 2 existe
                        If .Worksheets.Count > 1 Then
                            'On pointe la feuille
                            With .Worksheets(2)
                                '.Worksheets(2).Activate
                                'On pointe la cellule ...
                                Set ma = .Range("C6").MergeArea
                                If ma.Address = "$C$6:$D$6" And .Range("C6").value Like "*" & OS.Range("D8").value & "*" Then
                                    Classeur = WbClient.FullName
                                    WbClient.Close 'SaveChanges:=True 'Pourquoi le sauvegarder pour le détruire ensuite?
                                    Kill Classeur
                                    '? Si j'ai bien compris il s'agit de votre fichier "source" CS?
                                    'Application.ActiveWorkbook.Close False
                                    CS.Close False
                                End If
                            End With
                        End If
                    End With
                End If
            Next I
            Else
            UserForm48.Show
        End If
    End If

Code non testé bien sûr
++
Qwaz

[JukeBoX]

Merci pour ton aide !
Oui je vais faire les quelques modifications pour plus de sécurité, on n'est jamais trop prudent !

Le fichier CS est celui qui sert à comparer les valeurs avec les autres fichiers qui seront ouverts puis détruits. C'est d'ailleurs depuis ce fichier que la macro est exécutée.

[JukeBoX]

Bonjour,

La réponse est oui mais il ne faut pas oublier de le fermer avant de le supprimer

Merci pour la réponse !

Du coup je rajoute ceci ?

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
ReDim T(0 To 0)
Dim I As Long
Dim Classeur As String
Set CS = Workbooks("EXEMPLE")
Set OS = CS.Worksheets("TEST")
ScanFolder T, "U:\Public", OS.Range("D6").Value & "*.xls*", False
If Not IsEmpty(T(0)) Then
UserForm47.Show
For I = 0 To UBound(T)
Workbooks.Open T(I)
Worksheets(2).Activate
Set ma = Range("C6").MergeArea
If ma.Address = "$C$6:$D$6" And Range("C6").Value Like "*" & OS.Range("D8").Value & "*" Then
Classeur = Application.ActiveWorkbook.FullName
ActiveWorkBook.Close SaveChanges:=True
Kill Classeur
Application.ActiveWorkbook.Close False
End If
Next I
Else
UserForm48.Show
End If