Discussion :

[tequillaman]

Bonjour à tous,
Après un joli viaduc de repos, reprise de l'apprentissage de VB
J'ai lu pas mal de topic sur la recherche de fichier dans des dossiers et sous dossiers. J'ai ai extrait le code suivant (avec une partie du miens).
Mon besoins est le suivant. Je souhaite que me macro recherche un fichier qui se nomme en partie via le text box dans des dossiers et sous dossier.
J'ai un chemin type xxxxxxx\xxxxx\campage\ dans se dossier, j'ai des sous dossiers en fonction de l'année et à l'interieur des sous dossiers en fonction de la semaine.
ex xxxx\xxxx\campagne\2016\S15\fichier a trouver
Je voudrais que ma macro qui met à jour un tableau recherche dans les dossiers et sous dossiers de l'année N-1 et N mon fichier demandé dans le textbox.
La partie du code que j'ai trouvé provoque une erreur à cause du filesearch car je suis sous 2007. J'ai trouvé des articles qui me dit de télécharger un complément ClasseFileSearch mais je en peu pas dans l'entreprise à cause des verroux de proxy.
Auriez-vous une autre piste?
Est-ce possible si je sauvegarde le fichier macro en .xls.

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
49
50
51
52
53
54
55
56
Private Sub Valider_Click()
    Dim CHE As String
    Dim FIC As String
    Dim REC1 As Range
    Dim name As String       'pour accepter le champs de saisie dans le userform
    Dim wbk2 As Workbook    ' pour fermer le classeur à la fin
 
    name = EVERTZ.saisie.Text
 
 
    'FIC = Dir(CHE & "\" & name & "*")
 
    ' vérification de la présence de la coulée dans le tableau de récupération
    Set REC1 = Range("A1:A65000").Find(name, lookat:=xlWhole)
 
    If REC1 Is Nothing Then    'si coulée non trouvée
        MsgBox ("Veillez importer les données de contrôle avant les données EVERTZ")
 
    Else
 
 
 
Static s As Integer
Dim repertoire()
'Detecter les repertoires
 
CHE = "E:\UL_EVERTZ\Suivi MAM et réparations\Campagne\"
myname = Dir(CHE, vbDirectory)
Do While myname <> ""
    If myname <> "." And myname <> ".." And myname <> "..." Then
        If (GetAttr(CHE & myname) And vbDirectory) = vbDirectory Then
            Debug.Print myname
            ReDim Preserve repertoire(s)
            repertoire(s) = CHE & myname
            s = s + 1
        End If
    End If
    myname = Dir
Loop
 
'Lister les fichier des repertoires
For g = 0 To s - 1
MsgBox repertoire(g)
Set fs = Application.FileSearch
With fs
    .LookIn = repertoire(g)
    .Filename = "*.*"
    .Execute
        For i = 1 To .FoundFiles.Count
            MsgBox .FoundFiles(i) 'intégrer le code d'apres à la place
        Next i
        If .FoundFiles.Count = 0 Then
        MsgBox "fichier non trouvé"
        End If
End With
Next

[joe.levrai]

Bonjour,

je te conseilles d'utiliser les objets FSO (File Scripting Object) qui permettent de parcourir les dossiers, sous-dossiers, fichiers etc...

fait une recherche sur le forum, il y a des centaines de sujets, ainsi que des tutos pour apprendre à manipuler.

voici pour commencer : http://warin.developpez.com/access/fichiers/

[tequillaman]

Merci joe
Il me reste un petit problème:
La recherche se fait bien, l'ouverture du fichier aussi, la copie des cellules également
le problème c'est qu'il ne me "colle" pas les cellules dans mon fichier et me met le msgbox err je ne comprends pas pourquoi
je vous joint le code

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder)
On Error GoTo err
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Scripting.Folder
    Dim oFl As File
    Dim wbk2 As Workbook
 
    If p_oFld Is Nothing Then
        'Instanciation du FSO
        Set oFSO = New Scripting.FileSystemObject
        'Accède au répertoire du départ de recherche
        Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
    End If
    Set oFl = p_oFld.Files(p_strFichier)
    MsgBox oFl.Path
    'ouverture du fichier
    Workbooks.Open Filename:=oFl.Path
    EVERTZ.Hide
    'copie
    Set wbk2 = ActiveWorkbook       'nommer wbk2 avec le nom du fichier ouvert
            Sheets("base récup").Select          ' choisir la feuille base recup
            ' copie
            Range("A2:B2").Copy
            Windows("Base de données.xls").Activate  ' revenir dans le classeur dans lequel copier les données
 
 
            'selectionne la cellule où copier
            Range(REC1, REC1.End(xlToLeft)).Select
            ActiveCell.Offset(0, 29).Select
            'colle
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
 
            wbk2.Close False 'fermer classeur wbk2
            'ajouter une autre coulée?
            nouvelajout.Show
 
 
 
SubDir:
'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
 
fin:
    Exit Sub
err:
    Select Case err.Number
        Case 53: Resume SubDir
        Case Else:
            MsgBox "Erreur inconnue"
            Resume fin
    End Select
 
End Sub
 
Private Sub Valider_Click()
    Dim CHE As String
    Dim REC1 As Range
    Dim name As String       'pour accepter le champs de saisie dans le userform
    Dim FICEVERTZ As String
 
    name = EVERTZ.saisie.Text
    FICEVERTZ = name & ".xls"
 
 
    ' vérification de la présence de la coulée dans le tableau de récupération
    Set REC1 = Range("A1:A65000").Find(name, lookat:=xlWhole)
 
    If REC1 Is Nothing Then    'si coulée non trouvée
        MsgBox ("Veillez importer les données de contrôle avant les données EVERTZ")
 
    Else
 
 
        Explorer FICEVERTZ, "E:\UL_EVERTZ\Suivi MAM et réparations\Campagne\"
 
    End If
End Sub

[joe.levrai]

Ta variable REC1 a une portée qui ne dépasse pas la procédure où elle est déclarée :

Code :

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

1
2
3
Private Sub Valider_Click()
    Dim CHE As String
    Dim REC1 As Range

tu tentes de la réutiliser dans une autre procédure :

Code :

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

1
2
3
4
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder)
'[...]
 'selectionne la cellule où copier
            Range(REC1, REC1.End(xlToLeft)).Select

je ne sais pas si c'est le seul problème, déclare déjà ta variable en public sur le module, et contrôle en pas à pas si tout se déroule mieux.


Y'a ensuite un gros travail de simplification à faire ... il est inutile de sélectionner et activer des objets pour les utiliser. Au contraire, c'est source d'ennuis futurs.
De même, ta gestion d'erreur, bien que louable, n'est pas assez complète :

- dans ton case Else, il est toujours opportun de renvoyer le numéro d'erreur et sa description (Err.Number et Err.Description) plutôt que de simplement dire "Erreur inconnue". Ca aide grandement à débugguer

- évite d'utiliser le mot "err" pour identifier ton bloc de gestion de l'erreur : err est un mot réservé qui renvoie aux objets erreurs d'execution


Mais pour le moment corrigeons déjà les problèmes qui se présentent

[tequillaman]

Effectivement, c'était bien la variable que je n'avais pas bien déclarée

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
Public REC1 As Range
 
 
 
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder)
On Error GoTo err
    Dim oFSO As Scripting.FileSystemObject
    Dim oFld As Scripting.Folder
    Dim oFl As File
    Dim wbk2 As Workbook
 
    If p_oFld Is Nothing Then
        'Instanciation du FSO
        Set oFSO = New Scripting.FileSystemObject
        'Accède au répertoire du départ de recherche
        Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
    End If
    Set oFl = p_oFld.Files(p_strFichier)
    'MsgBox oFl.Path affiche le chemin du fichier
    'ouverture du fichier
    Workbooks.Open Filename:=oFl.Path
    'copie
    Set wbk2 = ActiveWorkbook       'nommer wbk2 avec le nom du fichier ouvert
            Sheets("base récup").Select          ' choisir la feuille base recup
            ' copie
            Range("A2:B2").Copy
            Windows("Base de données.xls").Activate  ' revenir dans le classeur dans lequel copier les données
 
 
            'selectionne la cellule où copier
            Range(REC1, REC1.End(xlToLeft)).Select
            ActiveCell.Offset(0, 34).Select
            'colle
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
 
            wbk2.Close False 'fermer classeur wbk2
            'ajouter une autre coulée?
            nouvelajout.Show
 
 
 
SubDir:
'Explore les sous-dossiers
    For Each oFld In p_oFld.SubFolders
        Explorer p_strFichier, p_strCheminDepart, oFld
        DoEvents
    Next oFld
 
fin:
    Exit Sub
err:
    Select Case err.Number
        Case 53: Resume SubDir
        Case Else:
            MsgBox "Erreur inconnue"
            Resume fin
    End Select
 
End Sub
 
Private Sub Valider_Click()
    Dim name As String       'pour accepter le champs de saisie dans le userform
    Dim FICEVERTZ As String
 
    name = EVERTZ.saisie.Text
    FICEVERTZ = name & ".xls"
 
    Windows("Base de données.xls").Activate
    ' vérification de la présence de la coulée dans le tableau de récupération
    Set REC1 = Range("A1:A65000").Find(name, lookat:=xlWhole)
 
    If REC1 Is Nothing Then    'si coulée non trouvée
        MsgBox ("Veillez importer les données de contrôle avant les données EVERTZ")
 
    Else
 
 
        Explorer FICEVERTZ, "E:\UL_EVERTZ\Suivi MAM et réparations\Campagne\"
 
    End If
End Sub

Tu me parlais de simplifier le code. de quelle manière?
Saurais-tu où mettre un msgbox si le fichier n'existe pas?

[joe.levrai]

Bonjour,

je ne suis pas sûr de bien saisir ce que tu veux faire.

tu parcours une arborescence complète pour rechercher un fichier qui peut exister plusieurs fois ou non ?
à moins qu'il faille trouver un unique fichier mais on ne sait pas dans quel dossier ?
je penche pour le fichier unique, au vu de la manière dont tu colles les valeurs (s'il y avait plusieurs fichiers les valeurs s'écraseraient à chaque fois)


voici une proposition sans gestion complexe des erreurs. Attention car je l'ai écrite à main levée et pas testée, il y a probablement quelques ajustements à faire
L'idée concerne surtout la structure de ton traitement, on décompose le traitement en plusieurs étapes, en s'aidant de deux variables publiques :

Code :

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

1
2
Public FichierTrouve As Boolean
Public Plage As Range

1) Collecter les données d'entrée (dossier de départ, nom du fichier, la plage Excel qui contient le nom du fichier)

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
Private Sub Valider_Click()
Dim Chemin As String
Dim NomFich As String
    Chemin = "E:\UL_EVERTZ\Suivi MAM et réparations\Campagne\"
    NomFich = evertz.saisie.Text & ".xls"
 
    ' vérification de la présence de la coulée dans le tableau de récupération
    Set Plage = Sheets("Base de données.xls").Range("A1:A65000").Find(NomFich, lookat:=xlWhole)
 
    If Plage Is Nothing Then    'si coulée non trouvée
        MsgBox ("Veuillez importer les données de contrôle avant les données EVERTZ")
    Else
        Explorer NomFich, Chemin
 
        If Not FichierTrouve Then MsgBox "Le Fichier suivant n'a pas été trouvé : " & NomFich
        'ajouter une autre coulée?
        nouvelajout.Show
    End If
End Sub

2) parcourir chaque dossier de l'arborescence

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
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.folder)
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.folder
Dim oFl As File
 
    If p_oFld Is Nothing Then
        'Instanciation du FSO
        Set oFSO = New Scripting.FileSystemObject
        On Error Resume Next
            Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
        On Error GoTo 0
 
        If p_oFld Is Nothing Then
            MsgBox "Le dossier racine est introuvable : " & vbCrLf & p_strCheminDepart
            Exit Sub
        End If
    End If
 
    ' récursion pour parcourir l'ensemble de l'arborescence
    For Each oFld In p_oFld.SubFolders
        If Not FichierTrouve Then
            Explorer p_strFichier, p_strCheminDepart, oFld
            DoEvents
        End If
    Next oFld
End Sub

3) Chercher le fichier dans le dossier (là on peut utiliser la fonction Dir() plutôt que du FSO ...)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub ChercheFichier(NomFichier As String, DossierRecherche As Scripting.folder)
Dim LeFichier As Scripting.File
    On Error Resume Next
        Set LeFichier = DossierRecherche.Files(NomFichier)
    On Error GoTo 0
 
    If Not LeFichier Is Nothing Then
        CopieDonnees (LeFichier.Path)
        FichierTrouve = True
    End If
End Sub

4) copier les données

Code :

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

1
2
3
4
5
6
Sub CopieDonnees(CheminFichier As String)
    With Workbooks.Open(CheminFichier)
        .Sheets("base récup").Range("A2:B2").Copy Plage.Offset(0, 34)
        .Close False
    End With
End Sub

[tequillaman]

Salut,
Effectivement, j'ai bien un seul fichier qui as le nom que je saisi dans le textbox dans les dossiers à rechercher.
Je vais regarder se que tu m'as proposé car sa a le mérite de décomposer la macro.
Je te redit sa.

J'ai testé ton code Joe, il ne me trouve jamais le fichier.
Je ne voit pas la commande qui enchaîne sur la fonction ChercheFichier().

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Sub ChercheFichier(NomFichier As String, DossierRecherche As Scripting.Folder)
Dim LeFichier As Scripting.File
    On Error Resume Next
        Set LeFichier = DossierRecherche.Files(NomFichier)
    On Error GoTo 0
 
    If Not LeFichier Is Nothing Then
        CopieDonnees (LeFichier.Path)
        FichierTrouve = True
    End If
End Sub

je devrait avoir une commande dans la fonction explorer() non?

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
Sub Explorer(p_strFichier As String, p_strCheminDepart As String, Optional p_oFld As Scripting.Folder)
Dim oFSO As Scripting.FileSystemObject
Dim oFld As Scripting.Folder
Dim oFl As File
 
    If p_oFld Is Nothing Then
        'Instanciation du FSO
        Set oFSO = New Scripting.FileSystemObject
        On Error Resume Next
            Set p_oFld = oFSO.GetFolder(p_strCheminDepart)
 
        On Error GoTo 0
 
        If p_oFld Is Nothing Then
            MsgBox "Le dossier racine est introuvable : " & vbCrLf & p_strCheminDepart
            Exit Sub
        End If
    End If
 
    ' récursion pour parcourir l'ensemble de l'arborescence
    For Each oFld In p_oFld.SubFolders
        If Not FichierTrouve Then
            Explorer p_strFichier, p_strCheminDepart, oFld
            DoEvents
        End If
    Next oFld
End Sub

[joe.levrai]

C'était en effet très bancal cette proposition écrite à la volée

voici une autre proposition

1) Variables à portée module

Code :

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

1
2
3
4
5
Dim FichierTrouve As Boolean
Dim Plage As Range
Dim NomFichier As String
Dim CheminSource As String
Dim oFSO As Scripting.FileSystemObject

2) Calcul des variables d'entrée

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
Private Sub Valider_Click()
    CheminSource = "E:\UL_EVERTZ\Suivi MAM et réparations\Campagne\"
    NomFichier = evertz.saisie.Text & ".xls"
    FichierTrouve = False
 
    ' vérification de la présence de la coulée dans le tableau de récupération
    Set Plage = Sheets("Base de données.xls").Range("A1:A65000").Find(NomFichier, lookat:=xlWhole)
 
    If Plage Is Nothing Then    'si coulée non trouvée
        MsgBox ("Veuillez importer les données de contrôle avant les données EVERTZ")
    Else
        InitialiseExploration
 
        If Not FichierTrouve Then MsgBox "Le Fichier suivant n'a pas été trouvé : " & NomFichier
 
        'ajouter une autre coulée?
        nouvelajout.Show
    End If
End Sub

3) Initialiser le parcours de l'arborescence

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
Sub InitialiseExploration()
Dim p_oFld As Scripting.Folder
 
Set oFSO = New Scripting.FileSystemObject
 
On Error Resume Next
    Set p_oFld = oFSO.GetFolder(CheminSource)
On Error GoTo 0
 
If p_oFld Is Nothing Then
    MsgBox "Le dossier racine est introuvable : " & vbCrLf & CheminSource
    Exit Sub
Else
    Call DecortiqueArbo(p_oFld)
End If
 
End Sub

4) Décortiquer l'arborescence pour chercher le fichier

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub DecortiqueArbo(Dossier As Scripting.Folder)
Dim SousDossier As Scripting.Folder
    If FichierTrouve Then Exit Sub
 
    If FichierExiste(Dossier.Path) Then
        FichierTrouve = True
        Call CopieDonnees(Dossier.Path & "/" & NomFichier)
    ElseIf Dossier.SubFolders.Count > 0 Then
        For Each SousDossier In Dossier.SubFolders
            Call DecortiqueArbo(SousDossier)
        Next SousDossier
    End If
End Sub

5) La fonction qui vérifie si le fichier existe dans un dossier donné

Code :

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

1
2
3
Function FichierExiste(CheminDossier As String) As Boolean
    FichierExiste = Dir(CheminDossier & "\" & NomFichier) <> ""
End Function

6) La procédure de copie des données

Code :

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

1
2
3
4
5
6
Sub CopieDonnees(CheminFichier As String)
    With Workbooks.Open(CheminFichier)
        .Sheets("base récup").Range("A2:B2").Copy Plage.Offset(0, 34)
        .Close False
    End With
End Sub

[tequillaman]

Qu'appel tu variables à portée module?

[joe.levrai]

Ce sont des variables que tu déclares tout en haut d'un module

contrairement aux variables publiques, elles ne vont pas plus loin que le module dans lequel elles sont déclarées.

La seule différence : "Dim" à la place de "Public"

[tequillaman]

Voila toute mon ignorance
Je n'ai pas de code dans les modules.
module1

Code :

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

1
2
3
Sub RECHERCHE()
menu.Show
End Sub

module2

Code :

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

1
2
3
Sub RECHERCHE()
EVERTZ.Show
End Sub

tout le reste du code je l'ai mis après le bouton valider (double clic) de mes userforms
C'est surement une annerie non? J'ai toujours fait comme ça.

J'ai rien dit dsl je me mélange, je test et je reviens vers toi.

[joe.levrai]

Non non, ta remarque est très juste au contraire

alors :

1) tu mets dans ton userform la procédure liée à ton bouton de validation

2) dans un module standard :

- tu mets les variables en public pour qu'elles soient accessibles depuis le userform
- tu y mets en dessous toutes les autres procédures

[tequillaman]

Salut Joe, et le forum,
C'est bon, sa fonctionne, j'ai du juste modifier la fonction copie
Ta fonction copie je ne sait pas pourquoi me met des liens vers le fichier mais pour la mauvaise feuille et mauvaises cellules
les cellules que je veut récupérer sont des liens vers d'autres cellules car dans la feuille source, les cellules ne sont pas cote à cote.
Du coup j'ai fait comme sa

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
 
Sub CopieDonnees(CheminFichier As String)
    With Workbooks.Open(CheminFichier)
        .Sheets("base récup").Range("A2:B2").Copy 'Plage.Offset(0, 36)
 
        Windows("Base de données.xls").Activate  ' revenir dans le classeur dans lequel copier les données
 
 
            'selectionne la cellule où copier
            Range(Plage, Plage.End(xlToLeft)).Select
            ActiveCell.Offset(0, 36).Select
            'colle
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
        .Close False
    End With
End Sub

[joe.levrai]

Tu repars sur des mauvaises habitudes, à vouloir activer tes objets et fenêtres avant d'agir dessus

pourquoi ne pas modifier la proposition ? Elle faisait une copie intégrale (y compris les formats et formules), il faut juste faire un collage spécial valeur

ainsi, ceci :

Code :

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

1
2
3
4
5
6
Sub CopieDonnees(CheminFichier As String)
    With Workbooks.Open(CheminFichier)
        .Sheets("base récup").Range("A2:B2").Copy Plage.Offset(0, 34)
        .Close False
    End With
End Sub

devient :

Code :

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

1
2
3
4
5
6
7
Sub CopieDonnees(CheminFichier As String)
    With Workbooks.Open(CheminFichier)
        .Sheets("base récup").Range("A2:B2").Copy
        Plage.Offset(0, 34).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        .Close False
    End With
End Sub

Bien sûr, la plage où sont copiées les données est peut être fausse (seul toi peux le voir) et tu dois la corriger.
Mais essaye de conserver des reflexes efficaces : pas de sélection des objets, pas de référence plage actives (toujours indiquer la feuille et le classeur concerné ... ou utiliser une variable Range) etc..

[tequillaman]

effectivement c'est mieux comme sa.
Désolé, j'apprends donc le peu de chose que je connais revienne sans arrêt même si c'est pas les mieux
C'est nickel merci

Je vais essayer de refaire pareil avec mon autre bouton pour retirer mes mochetés.
Merci encore pour tout

Joe, j'ai tenté de modifié mon autre code en fonction de se que tu m'as fait avant.
Sa fonctionne toujours, c'est déjà sa

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
49
50
51
52
Private Sub Valider_Click()
    Dim Chemin As String
    Dim FICHIER As String
    Dim RECHERCHE As Range
    Dim nom As String       'pour accepter le champs de saisie dans le userform
    Dim vide As Range
 
    nom = menu.saisie.Text
    Chemin = ThisWorkbook.Path & "\Fiches controle billettes\"
    FICHIER = Dir(Chemin & "\" & nom & "*")
 
 
If Len(nom) < 5 Then ' vérification de la saisie minimum 5 caractères
   MsgBox "Saisissez une coulée sur 5 caractères"
 
Else
   If FICHIER = "" Then  ' vérification de l'existance du fichier
        MsgBox "le fichier est introuvable" ' message erreur si il n'existe pas
 
    Else
        Set RECHERCHE = Range("A1:A65000").Find(nom, lookat:=xlWhole)  'recherche de la coulée dans le tableau
        Set vide = Range("A65000").End(xlUp).Offset(1)
        vide.Select
 
        'créé un lien hypertext vers le fichier source
                Dim objLink As Hyperlink
                Set objLink = ActiveSheet.Hyperlinks.Add(ActiveCell, Chemin & FICHIER)
                With objLink
                    .SubAddress = "A1:C10"
                End With
 
        If RECHERCHE Is Nothing Then    'si coulée non trouvée
            With Workbooks.Open(Chemin & FICHIER)
                .Sheets("RESUM").Range("A2:Aj2").Copy
                vide.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                .Close False
            End With
 
        Else        ' si coulée trouvée
            MsgBox ("La coulée " & x & " éxiste déjà")
 
        End If
 
 
        'ajouter une autre coulée?
        nouvelajout.Show
 
    End If
 
End If
 
End Sub

a la place de:

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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
Private Sub Valider_Click()
    Dim Chemin As String
    Dim FICHIER As String
    Dim RECHERCHE As Range
    Dim nom As String       'pour accepter le champs de saisie dans le userform
    Dim wbk1 As Workbook    ' pour fermer le classeur à la fin
    Dim x As String
    nom = menu.saisie.Text
 
 
 
    Chemin = ThisWorkbook.Path & "\Fiches controle billettes\"
 
    FICHIER = Dir(Chemin & "\" & nom & "*")
 
 
If Len(nom) < 5 Then ' vérification de la saisie minimum 5 caractères
 
    MsgBox "Saisissez une coulée sur 5 caractères"
 
Else
 
    If FICHIER = "" Then  ' vérification de l'existance du fichier
        MsgBox "le fichier est introuvable" ' message erreur si il n'existe pas
 
    Else  ' Si ok ouverture du fichier
        Workbooks.Open Filename:=Chemin & FICHIER   'ouverture du fichier
        Set wbk1 = ActiveWorkbook       'nommer wbk1 avec le nom du fichier ouvert
        Sheets("RESUM").Select          ' choisir la feuille RESUM
        x = Range("A2").Value           ' Attribuer à x la valeur de la cellule A2 nom de coulée
        Windows("Base de données.xls").Activate  ' revenir dans le classeur dans lequel copier les données
        ' vérification de l'abscence de la coulée dans le tableau de récupération
        Set RECHERCHE = Range("A1:A65000").Find(x, lookat:=xlWhole)
 
        If RECHERCHE Is Nothing Then    'si coulée non trouvée
            wbk1.Activate       ' activer le classeur pour récupérer les données
 
            ' copie
            Sheets("RESUM").Range("A2:Aj2").Copy
 
            Windows("Base de données.xls").Activate  ' revenir dans le classeur dans lequel coller les données
            Range("A65000").End(xlUp).Offset(1).Select  'se placer dans la première ligne vide
 
            'créé un lien hypertext vers le fichier source
            Dim objLink As Hyperlink
            Set objLink = ActiveSheet.Hyperlinks.Add(ActiveCell, Chemin & FICHIER)
            With objLink
                .SubAddress = "A1:C10"
            End With
 
            ' Collage spécial value only
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
 
        Else        ' si coulée trouvée
 
            MsgBox ("La coulée " & x & " éxiste déjà")
 
        End If
 
        wbk1.Close False 'fermer classeur wbk1
 
        'ajouter une autre coulée?
        nouvelajout.Show
 
 
    End If
 
End If
 
End Sub

Je ne sait pas si sa change grand chose mais sa évite des variables et des select

[joe.levrai]

A part trois "petites choses" :

1) si tu ne dois utiliser un objet qu'une seule fois, c'est pas utile de le passer dans une variable pour ensuite utiliser la variable, va direct à l'essentiel

Ceci

Code :

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

1
2
3
4
5
6
'créé un lien hypertext vers le fichier source
                Dim objLink As Hyperlink
                Set objLink = ActiveSheet.Hyperlinks.Add(ActiveCell, Chemin & FICHIER)
                With objLink
                    .SubAddress = "A1:C10"
                End With

Devient

Code :

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

1
2
3
With ActiveSheet.Hyperlinks.Add(ActiveCell, Chemin & FICHIER)
    .SubAddress = "A1:C10"
End With

2) Au delà de la version 2003, excel dispose d'un million de lignes, dans un souci de généralisation de tes procédures, il est préférable d'utiliser la propriété Rows.Count plutôt que d'écrire en dur 65000 ... imagine si ton fichier fait 80 000, ça ne fonctionne plus correctement

par exemple, ceci

Code :

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

Set vide = Range("A65000").End(xlUp).Offset(1)

devient

Code :

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

Set vide = Cells(Rows.Count,1).End(xlUp).Offset(1)

3) Tu sélectionnes encore des objets inutilement

ceci

Code :

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

vide.Select

ne sert à rien dans ton code, si ce n'est à le ralentir, et provoquer par exemple une erreur si la feuille était masquée

Plutôt que :

- activer un objet
- l'utiliser en temps qu'objet actif (ActiveSheet, Activecell, un Range() qui n'est pas rattaché à une feuille)

On préfère écrire intégralement une filiation

par exemple, ceci :

Code :

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

1
2
3
Sheets("MaFeuille").Activate
Range("A1").Select
Selection.Copy Range("B3")

doit devenir :

Code :

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

1
2
3
With Sheets("MaFeuille")
    .Range("A1").Copy .Range("B3")
End With

VBA n'a pas besoin que tu sois sur "quelquechose" pour travailler, dès lors que tu lui indiques correctement le chemin. Il ira chercher comme un grand


Bonus) Le nom des variables ... je te conseille de toujours mettre la première lettre en majuscule
Ainsi, non seulement tu repères facilement tes variables quand tu lis ton code, mais quand tu le rédiges, VBE va automatiquement remettre la majuscule si tu as écris en minuscule. Ca te permet, durant la rédaction, de toujours être sûr d'avoir bien écrit ta variable.

Et au passage, mettre "Option Explicit" tout en haut de ton module t'obligera à déclarer toutes tes variables. Si tu écris mal une variable, tu auras un message qui t'en avertira

[tequillaman]

A part trois "petites choses" :

1) si tu ne dois utiliser un objet qu'une seule fois, c'est pas utile de le passer dans une variable pour ensuite utiliser la variable, va direct à l'essentiel

Ceci

Code :

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

1
2
3
4
5
6
'créé un lien hypertext vers le fichier source
                Dim objLink As Hyperlink
                Set objLink = ActiveSheet.Hyperlinks.Add(ActiveCell, Chemin & FICHIER)
                With objLink
                    .SubAddress = "A1:C10"
                End With

Devient

Code :

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

1
2
3
With ActiveSheet.Hyperlinks.Add(ActiveCell, Chemin & FICHIER)
    .SubAddress = "A1:C10"
End With

Bon a savoir, a chaque fois j'ajoute des variable se qui me donne des fois une liste longue comme le bras pour pas grand chose.

2) Au delà de la version 2003, excel dispose d'un million de lignes, dans un souci de généralisation de tes procédures, il est préférable d'utiliser la propriété Rows.Count plutôt que d'écrire en dur 65000 ... imagine si ton fichier fait 80 000, ça ne fonctionne plus correctement

par exemple, ceci

Code :

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

Set vide = Range("A65000").End(xlUp).Offset(1)

devient

Code :

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

Set vide = Cells(Rows.Count,1).End(xlUp).Offset(1)

OK, effectivement, vu que c'est un fichier qui évolu très rapidement, on risque d'être vide dans la mouise.
Par contre, comment le mettre pour se code?

Code :

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

Set Plage = Range("A1:A65000").Find(nom, lookat:=xlWhole)

a chaque fois que j'essai de le modifier j'ai des erreurs

3) Tu sélectionnes encore des objets inutilement

ceci

Code :

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

vide.Select

ne sert à rien dans ton code, si ce n'est à le ralentir, et provoquer par exemple une erreur si la feuille était masquée

Plutôt que :

- activer un objet
- l'utiliser en temps qu'objet actif (ActiveSheet, Activecell, un Range() qui n'est pas rattaché à une feuille)

On préfère écrire intégralement une filiation

par exemple, ceci :

Code :

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

1
2
3
Sheets("MaFeuille").Activate
Range("A1").Select
Selection.Copy Range("B3")

doit devenir :

Code :

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

1
2
3
With Sheets("MaFeuille")
    .Range("A1").Copy .Range("B3")
End With

VBA n'a pas besoin que tu sois sur "quelquechose" pour travailler, dès lors que tu lui indiques correctement le chemin. Il ira chercher comme un grand

J'ai utilisé activate car mes boutons macro sont sur un fichier que l'utilisateur utilise (nul cette phrase).
Le bouton lance la macro présente dans un autre classeur qui sert de base de données en rassemblant des données de pleins d'autres fichiers. J'ai mis le select et l'activate pour éviter des erreurs, sinon, avec la manière courte que tu me montre, sa récupère les données et les copie dans le fichier actif et non dans le fichier "base".

[joe.levrai]

Bonjour,

pour ça

Code :

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

Set Plage = Range("A1:A65000").Find(nom, lookat:=xlWhole)

Comme tu l'as vu, j'ai plutôt utilisé Cells(x,y) au lieu de Range ... ça permet de manipuler les numéros de colonnes plus facilement et de bien isoler la partie Ligne et la partie colonne

Comme souvent, on a plusieurs manières d'écrire dynamiquement la chose. Et pas forcément besoin d'utiliser Range ou Cells d'ailleurs.

Des manières un peu brutes, comme ici où on se prend pas la tête et on cherche dans toute la colonne de la feuille active

Code :

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

Set Plage = Columns(1).Find(nom, lookat:=xlWhole)

De façon un peu plus élaborée, en limitant la recherche sur la plage utilisée dans la feuille active

Code :

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

Set Plage = UsedRange.Columns(1).Find(nom, lookat:=xlWhole)

De façon un peu plus subtile, en limite la recherche sur la plage contigüe qui contient la cellule A1

Code :

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

Set Plage = CurrentRegion.Columns(1).Find(nom, lookat:=xlWhole)

Et finalement, des exemples avec Cells ... que personnellement je n'utiliserai pas (ce qui est au dessus est plutôt ma façon de procéder)

Code :

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

Set Plage = Range(Cells(1,1),Cells(Rows.Count,1).End(Xlup)).Find(nom, lookat:=xlWhole)

Code :

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

Set Plage = Cells(1,1).Resize(UsedRange.Rows.Count,1).Find(nom, lookat:=xlWhole)

J'ai plusieurs fois souligné que ces codes s'appliquent sur la feuille ACTIVE
En effet, si on indique pas l'objet parent (la feuille d'une plage par exemple .... ou le classeur d'une feuille), alors c'est l'objet actif qui est pris par défaut (la feuille active, le classeur actif, la cellule active etc...)

Ce qui va répondre à ta deuxième interrogation au sujet de la copie des feuilles
Voici un exemple qui copie une plage de la feuille Toto du classeur A, pour la coller dans la feuille Tata du classeur B
Il suffit de toujours référencer les filiations

Code :

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

WorkBooks("A").WorkSheets("Toto").Range("A1").Copy WorkBooks("B").WorkSheets("Tata").Range("B3")

Si tu dois utiliser plusieurs fois tes feuilles et tes classeurs, utilise des variables pour alléger l'écriture
C'est parfois plus pratique d'avoir deux lignes de déclaration de variables, plutôt de se retrouver à 5 reprises avec des lignes de codes longues comme un jour sans pain

Code :

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

1
2
3
4
5
6
7
Dim FeuilleSource as Worksheet
Dim FeuilleDest as Worksheet
 
Set FeuilleSource = WorkBooks("A").WorkSheets("Toto")
Set FeuilleDest = WorkBooks("B").WorkSheets("Tata")
 
FeuilleSource.Range("A1").Copy FeuilleDest.Range("B3")

[tequillaman]

Ok, du coup, j'ai une erreur

Code :

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

1
2
Dest.Activate
    Set vide = Cells(Rows.Count, 1).End(xlUp).Offset(1)

Je tente de le remplacer par

Code :

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

set vide = dest.Cells(Rows.Count, 1).End(xlUp).Offset(1)

si je lance la macro depuis le fichier dest pas de soucis puisque le fichier est "activé" mais si je lance la macro depuis mon fichier de consultation erreur 1004
erreur définie par l'application ou par l'objet

Pourtant vide est défini dans mon private sub et dest aussi

[joe.levrai]

Le classeur de consultation est bien ouvert ? Dans la même instance Excel que le fichier de départ ?

Comment sont déclarée les variables ?

Tu peux montrer la procédure complète histoire que je visualise mieux le contexte ?