Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Excel > Macros et VBA Excel
Macros et VBA Excel Vos questions relatives aux macros Excel, à l'utilisation de VBA et à l'automatisation de vos classeurs Excel.
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
Vieux 07/02/2010, 12h14   #1
Candidat au titre de Membre du Club
 
Inscription : janvier 2010
Messages : 23
Détails du profil
Informations forums :
Inscription : janvier 2010
Messages : 23
Points : 11
Points : 11
Par défaut Récupération de données sur plusieurs fichiers

Bonjour à tous ,
Voici mon problème
Je souhaiterais récupérer des données sur plusieurs fichiers Xls pour les compiler sur un fichier Xls unique.
Je bloque au niveau de la boucle dans les fichiers Xls de recupération des données.
Code :
If Ws.Cells(ligne, 1).Text = Wb.Worksheets(1)(ligne, 1) Then
J'ai un message d'erreur
Citation:
"erreur d'exécution '438':
Propriété ou méthode non gérée par cet objet
voici mon code

Code :
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
Sub recherche()
 
Dim Repertoire As String, Fichier As String
Dim Wb As Workbook
Dim Ws As Worksheet
 
Application.ScreenUpdating = False
 
'Définit la Première feuille du classeur contenant cette macro
'(pour recevoir les donnée extraites dans les autres classeurs).
Set Ws = ThisWorkbook.Worksheets(1)
 
'Définit le répertoire de recherche
Repertoire = "D:\Documents\Dossier D\TM \"
'Spécifie la recherche pour le fichiers .xls
Fichier = Dir(Repertoire & "*.xls")
 
'Boucle sur les fichiers du répertoire
Do While Fichier <> ""
    'Vérifie que le nom du classeur est différent du classeur
    'contenant cette macro (dans le cas ou il serait placé dans le même répertoire).
    If ThisWorkbook.Name <> Fichier Then
        'Ouvre chaque classeur
        Set Wb = Workbooks.Open(Repertoire & Fichier)
 
      For ligne = 5 To 8
    If Ws.Cells(ligne, 1).Text = Wb.Worksheets(1)(ligne, 1) Then
Ws.Cells(ligne, 2) = Wb.Worksheets(1)(ligne, 2)
End If
Next
 
        'Referme le classeur
        Wb.Close False
    End If
 
    Fichier = Dir
Loop
 
Application.ScreenUpdating = True
MsgBox "Terminé"
 
End Sub
Merci

Dernière modification par AlainTech ; 25/04/2010 à 13h20. Motif: Balises [code] et suppression couleurs
jose_67 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 07/02/2010, 12h36   #2
Membre Expert
 
Inscription : juillet 2007
Messages : 2 134
Détails du profil
Informations forums :
Inscription : juillet 2007
Messages : 2 134
Points : 2 154
Points : 2 154
Salut jose_67 et le forum
Nouveauté sur le forum : il existe des balises pour le code!!!!!
Peut-être
Code :
1
2
3
4
        For ligne = 5 To 8
            If Ws.Cells(ligne, 1).Text = Wb.Worksheets(1).Cells(ligne, 1) Then _
                Ws.Cells(ligne, 2) = Wb.Worksheets(1).Cells(ligne, 2)
        Next
A+
Gorfael est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 07/02/2010, 15h32   #3
Candidat au titre de Membre du Club
 
Inscription : janvier 2010
Messages : 23
Détails du profil
Informations forums :
Inscription : janvier 2010
Messages : 23
Points : 11
Points : 11
Merci pour les infos
Je viens d'adapter le code à mes besoins. Mais la marco est un peut trop long (à l'exécution) il faudrait que je limite la boucle à la dernière ligne renseigner pour aller plus vite dans la recherche
Comment faire pour remplacer
For i = 29 To 700 par (dernière ligne renseignée)
For j = 5 To 3000 par (dernière ligne renseignée)
I for 5 to (dernière ligne renseignée)
Et en plus je voudrais renvoyer le Nom du fichier en colonne 3 de mon fichier Ws


Code :
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
Dim Repertoire As String, Fichier As String
Dim Wb As Workbook
Dim Ws As Worksheet
Dim i, j As Single
 
Application.ScreenUpdating = False
 
'Définit la Première feuille du classeur contenant cette macro
'(pour recevoir les donnée extraites dans les autres classeurs).
Set Ws = ThisWorkbook.Worksheets(2)
 
'Définit le répertoire de recherche
Repertoire = "D:\Documents\Dossier DM\TM\"
'Spécifie la recherche pour le fichiers .xls
Fichier = Dir(Repertoire & "*.xls")
 
'Boucle sur les fichiers du répertoire
Do While Fichier <> ""
    'Vérifie que le nom du classeur est différent du classeur
    'contenant cette macro (dans le cas ou il serait placé dans le même répertoire).
    If ThisWorkbook.Name <> Fichier Then
        'Ouvre chaque classeur
        Set Wb = Workbooks.Open(Repertoire & Fichier)
 
       For i = 29 To 700
       For j = 5 To 3000
            If Ws.Cells(i, 2).Text = Wb.Worksheets(2).Cells(j, 1) Then _
                Ws.Cells(i, 18).Value = Wb.Worksheets(2).Cells(j, 2)
 
 
        Next j
        Next i
 
 
 
        'Referme le classeur
        Wb.Close False
    End If
 
    Fichier = Dir
Loop
 
Application.ScreenUpdating = True
MsgBox "Terminé"
 
End Sub
jose_67 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 07/02/2010, 16h40   #4
Expert Confirmé Sénior
 
Avatar de mercatog
 
Inscription : juillet 2008
Messages : 5 444
Détails du profil
Informations forums :
Inscription : juillet 2008
Messages : 5 444
Points : 12 758
Points : 12 758
ci joint lien http://www.developpez.net/forums/d45...gnees-feuille/

en plus, tu peux simplifier la partie concernée par ceci
Code :
1
2
3
4
5
6
7
8
9
10
11
Dim c As Range
Dim LastLig1 As Long, LastLig2 As Long
 
LastLig1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
LastLig2 = Wb.Worksheets(2).Cells(Rows.Count, 1).End(xlUp).Row
 
For i = 29 To LastLig1
    Set c = Wb.Worksheets(2).Range("A5:A" & LastLig2).Find(ws.Cells(i, 2).Text, LookIn:=xlValues, lookat:=xlWhole)
    If Not c Is Nothing Then ws.Cells(i, 18).Value = c.Offset(0, 1)
    Set c = Nothing
Next i
__________________
Cordialement.
mercatog est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 08/02/2010, 11h01   #5
Candidat au titre de Membre du Club
 
Inscription : janvier 2010
Messages : 23
Détails du profil
Informations forums :
Inscription : janvier 2010
Messages : 23
Points : 11
Points : 11
Tous d'abords merci à "Gorfael" et "Mercatog" pour cette aide rapide et efficace ma macro fonctionne.
Je voudrais encore pouvoir mettre dans ma (colonne 3) le nom du fichier d'ou arrive les valeurs
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Set Wb = Workbooks.Open(Repertoire & Fichier)
      
       LastLig1 = Ws.Cells(Rows.Count, 1).End(xlUp).Row
        LastLig2 = Wb.Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row

For i = 5 To LastLig2
            Set c = Wb.Worksheets(1).Range("B5:B" & LastLig2).Find(Ws.Cells(i, 1).Text, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then Ws.Cells(i, 3).Value = c.Offset(0, 16)
            Set c = Nothing
    'Ws.Cells(i, 3) = Fichier ???
        Next i
       
                
        
        Wb.Close False
    End If
Cordialement José
jose_67 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 08/02/2010, 18h06   #6
Expert Confirmé Sénior
 
Avatar de mercatog
 
Inscription : juillet 2008
Messages : 5 444
Détails du profil
Informations forums :
Inscription : juillet 2008
Messages : 5 444
Points : 12 758
Points : 12 758
bonjour, la 3ème colonne risque d'avoir 2 données, l'une effacera l'autre.
pour ta question, si tu veux le nom entier
Code :
1
2
3
4
5
6
            Set c = Wb.Worksheets(1).Range("B5:B" & LastLig2).Find(Ws.Cells(i, 1).Text, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then 
                 Ws.Cells(i, 3).Value = c.Offset(0, 16)
                 Ws.Cells(i, XX).Value = wb.fullname
             end if
            Set c = Nothing
__________________
Cordialement.
mercatog est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 08/02/2010, 20h48   #7
Candidat au titre de Membre du Club
 
Inscription : janvier 2010
Messages : 23
Détails du profil
Informations forums :
Inscription : janvier 2010
Messages : 23
Points : 11
Points : 11
Re bonjour effectivement il fallait comprendre colonne 2 et non 3 pour le reste c'est super çà marche super.
Encore merci.
jose_67 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +1. Il est actuellement 15h13.


 
 
 
 
Partenaires

Hébergement Web