Discussion :

[tequillaman]

Bonjour,
Chaque jour, des techniciens remplissent des tableaux excel tous de la même forme. Ils sont tous enregistrés dans le même dossier. Je voudrais recuperer certaines données de tous ces tableurs dans un tableau recap dans un autre excel dans le même dossier. Je souhaiterais que mon tableau recap s'incremente tout seul quand je l'ouvre si des techniciens on fait de nouveaux fichiers.
C'est possible?
Merci

[kiki29]

Salut, voir avec fusion fichiers xls*, txt d'un dossier et l'adapter à ton contexte.

[tequillaman]

Je ne cherche pas a fusionner les fichiers entre eux mais extraire certaines données (toujours les mêmes). Et je voudrais que mon fichier recap reçoive les données dès qu'un nouveau fichier est créé.

[kiki29]

..... et l'adapter à ton contexte

. Tu es dans une position attentiste du tout cuit.

A lire

[Nodens_swiss]

Hello

Je pense que les techniciens mettent les fichiers dans le même dossier.
Il te suffit de lister les fichiers se trouvant dans le dossier :
http://excel.developpez.com/faq/?pag...BoucleFichiers
Puis de les ouvrir un a un :
http://vb.developpez.com/faqvba/?page=3.2#BookOpen
Reste à extraire les infos dont tu as besoins

[tequillaman]

Merci pour ces info, je vais essayé d'utiliser la boucle pour répurérer ceux déjà existant après je reviendrais à de la saisie de nom de fichier via un userform.

Voici une partie de mon code qui plante. Quand je saisi dans mon userform le fichier que je veux ex: 61117 9LNW33, cela fonctionne mais si je ne met que 61117 car c'est la seule partie connue, j'ai une erreur. il me met les asterisk dans le nom au lieu de compléter tout seul. Je voulais utiliser se principe car j'ai des fichiers xls et xlsx a récupérer. Je ne comprends pas car dans le lien pour faire la boucle c'est écrit de la même manière.

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
Private Sub Valider_Click()
Dim CHEMIN As String
CHEMIN = "C:\Users\jalff\Desktop\test recup\test\New folder\"
        ' vérification de l'existance du fichier
If Dir(CHEMIN & menu.saisie.Text & "*.xlsx") = "" Then
        ' message erreur si il n'existe pas
MsgBox "le fichier est introuvable"
        ' Si ok ouverture du fichier
Else
Workbooks.Open Filename:=CHEMIN & menu.saisie.Text & "*.xlsx"
End If
 
' copie et colle cellule 1
 
 
 
 
' Pour fermer le fichier .xls
' Workbooks("doc1.xlsx").Close SaveChanges:=False
End Sub

[Nodens_swiss]

Essaye ça:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
 
PathReport = "C:\Users\jalff\Desktop\test recup\test\New folder\"
    NameReport = "61117"
    Fichier = Dir(PathReport & "\*.*")
    If Fichier <> "" Then
        Do
            Set Fso = CreateObject("Scripting.FileSystemObject")
            Set FileItem = Fso.GetFile(PathReport & Fichier)
 
            If Left(NameReport, Len(NameReport)) = Mid(FileItem, Len(PathReport) + 1, Len(NameReport)) Then
                Debug.Print FileItem
            End If
            Fichier = Dir
        Loop Until Fichier = ""

[tequillaman]

merci pour ta réponse.
Le problème, c'est que le nom du fichier n'est pas toujours 61117.
J'ai un userform dans lequel l'utilisateur saisie le nom du produit 61117 pour importer certains résultats des tests. le fichier du produit se nomme 61117 xxxx.xlsx
voir des fois .xls
c'est pour cela que je voulais utiliser l'asterisk car à part le dossier, je ne peut rien mettre en dur dans le code.

[Nodens_swiss]

Je suis d'accord avec kiki29
"Tu es dans une position attentiste du tout cuit."

Google it!! Ou cherche sur le forum!

It te suffit de changer "61117" par le contrôle se trouvant sur ton userform:

Code :

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

NameReport = NomduUserForm.NomduChamp.value

[tequillaman]

Bonjour,
Désolé, c'est que je ne comprends pas ce que tu m'avais écrit.
Je l'ai mis dans mon code mais c'est comme si de rien n'était, j'ai mon message box qui s'ouvre à chaque fois pour me dire que le fichier n'existe pas. Il manquait un end if que j'ai mis à la fin.
Il semble qu'incorporé comme je l'ai fait, il recherche un fichier qui se nomme '.' (vu en retirant du code la partie avec le msgbox "le fichier est introuvable"
Même sans me donner la solution, pourrais-tu m'expliquer quelle partie fait quoi dans se que tu m'as envoyé stp?

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
Private Sub Valider_Click()
            Dim CHEMIN As String
            Dim FICHIER As String
            Dim RECHERCHE As Range
 
            PathReport = "C:\Users\jalff\Documents\Contrôle billettes\premiers tests\test recup\test\New folder\"
            NameReport = menu.saisie.Text
            FICHIER = Dir(PathReport & "\*.*")
            If FICHIER <> "" Then
        Do
            Set Fso = CreateObject("Scripting.FileSystemObject")
            Set FileItem = Fso.GetFile(PathReport & FICHIER)
 
            If Left(NameReport, Len(NameReport)) = Mid(FileItem, Len(PathReport) + 1, Len(NameReport)) Then
                Debug.Print FileItem
            End If
            FICHIER = Dir
        Loop Until FICHIER = ""
        End If
 
 
            ' vérification de l'existance du fichier
        If Dir(FICHIER) = "" Then
            ' message erreur si il n'existe pas
            MsgBox "le fichier est introuvable"
            ' Si ok ouverture du fichier
        Else
            Workbooks.Open Filename:=FICHIER
 
            ' copie
 
            Sheets("RESUM").Select
            Range("A2,B2,c2,d2,e2,f2,g2,h2,i2,j2,k2,l2,m2,n2,o2,p2,q2,r2,s2,t2,u2,v2,w2,x2,y2,Z2").Select
            Selection.Copy
            Windows("test.xls").Activate
 
 
                ' vérification de l'abscence de la coulée
                Set RECHERCHE = Range("A1:A65000").Find(menu.saisie.Text, lookat:=xlWhole)
            If RECHERCHE Is Nothing Then
                ' Colle
                Range("A65000").End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
 
 
            Else
                MsgBox ("La coulée " & menu.saisie.Text & "éxiste déjà")
            End If
            ' Pour fermer le fichier .xls
            Workbooks(menu.saisie.Text & ".xlsx").Close SaveChanges:=False
 
        End If

[Nodens_swiss]

si tu met:

Code :

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

msgbox(menu.saisie.Text)

Tu dois obtenir le contenu de ta saisie. Si non c'est que tu as un problème ici.

[tequillaman]

re,
Désolé mais je n'ai pas réussi à mettre en place le code que tu m'a donné.
Ceci-dit, j'ai quand même réussi avec ceci je pense que c'est de mettre menu.saisie.text dans le nom du fichier qui posait problème, en ajoutant une variable nom qui prends la valeur, c'est good.
OUFFFFF!!!!

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
Private Sub Valider_Click()
            Dim CHEMIN As String
            Dim FICHIER As String
            Dim RECHERCHE As Range
            Dim nom As String
            
            nom = menu.saisie.Text
            
            CHEMIN = ThisWorkbook.Path & "\Fiches controle billettes\"
            
            FICHIER = Dir(CHEMIN & "\" & nom & "*")
            
            

            ' vérification de l'existance du fichier
        If FICHIER = "" Then
            ' message erreur si il n'existe pas
            MsgBox "le fichier est introuvable"
            ' Si ok ouverture du fichier
        Else
            ' vérification de l'abscence de la coulée
            Set RECHERCHE = Range("A1:A65000").Find(menu.saisie.Text, lookat:=xlWhole)
            If RECHERCHE Is Nothing Then
            
                Workbooks.Open Filename:=CHEMIN & FICHIER
                
                ' copie
                Sheets("RESUM").Select
                Range("A2:Z2").Select
                Selection.Copy
                Windows("CCR.xls").Activate
                ' Colle
                Range("A65000").End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                ' Pour fermer le fichier .xls
                Workbooks(CHEMIN & FICHIER).Close SaveChanges:=False
            Else
                MsgBox ("La coulée " & menu.saisie.Text & "éxiste déjà")
            End If

            
        End If

   
End Sub

maintenant mon problème est que ma ligne

Code :

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

Workbooks(CHEMIN & FICHIER).Close SaveChanges:=False

pour la fermeture automatique du fichier ne fonctionne plus.

[tequillaman]

Bonjour,
C'est bon, j'ai pu résoudre se petit problème avec une variable wbk1.close
Je joint le code pour ceux qui pourraient avoir besoin.
Merci encore à vous.

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
Private Sub Valider_Click()
            Dim CHEMIN As String
            Dim FICHIER As String
            Dim RECHERCHE As Range
            Dim nom As String
            Dim wbk1 As Workbook     ' le classeur qui doit s'ouvrir et se fermer seul
                        
            nom = menu.saisie.Text    ' champs saisi dans le userform
            
            CHEMIN = ThisWorkbook.Path & "\Fiches controle billettes\"
            
            FICHIER = Dir(CHEMIN & "\" & nom & "*")


            ' vérification de l'existance du fichier
        If FICHIER = "" Then
            ' message erreur si il n'existe pas
            MsgBox "le fichier est introuvable"
            ' Si ok ouverture du fichier
        Else
            ' vérification de l'abscence de la coulée
            Set RECHERCHE = Range("A1:A65000").Find(menu.saisie.Text, lookat:=xlWhole)
            If RECHERCHE Is Nothing Then
            
                Workbooks.Open Filename:=CHEMIN & FICHIER
                Set wbk1 = ActiveWorkbook     ' attribution a wbk1 du classeur actif a fermer plus tard
                ' copie
                Sheets("RESUM").Select
                Range("A2:Z2").Select
                Selection.Copy
                
                Windows("CCR.xls").Activate
                ' Colle
                Range("A65000").End(xlUp).Offset(1).Select
                Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                    :=False, Transpose:=False
                ' Pour fermer le fichier .xls
                wbk1.Close False

            Else
                MsgBox ("La coulée " & menu.saisie.Text & "éxiste déjà")
            End If

            
        End If


End Sub

[tequillaman]

Bonjour,
Je voulais mettre une condition si certaine cellules sont vides.
Cela fonctionne mais est-il possible de compacter un peut cela? C'est long et moche

Code :

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

1
2
3
If IsEmpty(Range("c1")) Or IsEmpty(Range("c2")) Or IsEmpty(Range("N1")) Or IsEmpty(Range("U1")) Or IsEmpty(Range("U2")) Or IsEmpty(Range("AF1")) Or IsEmpty(Range("AN1")) Or IsEmpty(Range("AS3")) Or IsEmpty(Range("AR4")) Or IsEmpty(Range("AN4")) Or IsEmpty(Range("AS60")) Or IsEmpty(Range("AR61")) Or IsEmpty(Range("AN61")) Then
MsgBox "merci de remplir tous les champs"
Else

merci