Recuperations données dans fichiers

Le
Philippe
bonjour

J'ai un certains nombre de fichiers mais tous commencent par delegat_ et je
voudrais dans ces fichiers récupérer des données pour faire une synthese
dans un nouveau fichier
Dans les fichiers delegat_x , delegat_y,delegat_z je voudrais récupérer des
données en G9,G13,G15,G17,G19,V9,AG9,O13,R13,Z13,AC13 et mettre les valeurs
dans un nouveau fichier delegat_date avec une ligne par fichier delegat_x ,
delegat_y,delegat_z
je ne connais pas les macros alors si vous pouviez m'aider
merci d'avance
Cordialement
Philippe
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Philippe
Le #22578241
Peut-etre plus comprénsible avec les fichiers
http://www.cijoint.fr/cjlink.php?file=cj201009/cij3LX0s4Z.xls
http://www.cijoint.fr/cjlink.php?file=cj201009/cijldPW6Yr.xls


"Philippe" i6v9f4$kpa$
bonjour

J'ai un certains nombre de fichiers mais tous commencent par delegat_ et
je voudrais dans ces fichiers récupérer des données pour faire une
synthese dans un nouveau fichier
Dans les fichiers delegat_x , delegat_y,delegat_z je voudrais récupérer
des données en G9,G13,G15,G17,G19,V9,AG9,O13,R13,Z13,AC13 et mettre les
valeurs dans un nouveau fichier delegat_date avec une ligne par fichier
delegat_x , delegat_y,delegat_z
je ne connais pas les macros alors si vous pouviez m'aider
merci d'avance
Cordialement
Philippe

DanielCo
Le #22578391
Bonjour.
Mets cette macro dans le classeur date (je n'ai traité que la cellule
G9) :

Sub test()
Dim Fich As String, Chemin As String, Ligne As Integer
Dim Sh As Worksheet
Application.ScreenUpdating = False
Set Sh = ThisWorkbook.Sheets("Feuil1")
With Sh
Ligne = 2
Chemin = "d:donneesdanielmpfe" 'à modifier
Fich = Dir(Chemin & "delegation_*")
Do While Fich <> ""
If Fich <> "delegation_date.xls" Then
Ligne = Ligne + 1
Workbooks.Open Chemin & Fich
.Cells(Ligne, 1) = [G9]
'etc.
ActiveWorkbook.Close False
End If
Fich = Dir
Loop
End With
Application.ScreenUpdating = True
End Sub

Cordialement.
Daniel



Peut-etre plus comprénsible avec les fichiers
http://www.cijoint.fr/cjlink.php?file=cj201009/cij3LX0s4Z.xls
http://www.cijoint.fr/cjlink.php?file=cj201009/cijldPW6Yr.xls


"Philippe" i6v9f4$kpa$
bonjour

J'ai un certains nombre de fichiers mais tous commencent par delegat_ et je
voudrais dans ces fichiers récupérer des données pour faire une synthese
dans un nouveau fichier
Dans les fichiers delegat_x , delegat_y,delegat_z je voudrais récupérer des
données en G9,G13,G15,G17,G19,V9,AG9,O13,R13,Z13,AC13 et mettre les valeurs
dans un nouveau fichier delegat_date avec une ligne par fichier delegat_x ,
delegat_y,delegat_z
je ne connais pas les macros alors si vous pouviez m'aider
merci d'avance
Cordialement
Philippe

michdenis
Le #22578511
Bonjour,

Dans ton fichier date où tu dois récupérer les données :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Tu insères un module : Menu / insertion / module
Tu y copies tout ce qui suit.

L'Exécution de la macro "Remplir_Le_Tableau" récupère toutes
les données dans devoir ouvrir le fichier source.

J'ai supposé que :
La racine du nom de chaque fichier est identique : "Delegat"
L'index x, y, z a été défini comme un chiffre de 1 à 3, c'est à adapter selon ceux des vrais fichiers
L'onglet de la feuille où sont les données de chaque fichier a le même nom "Feuil1"
Tu dois adapter le nom du répertoire selon ton environnement.

'------------------------------
Sub Remplir_Le_Tableau()
Dim Arr(), Elt As Variant, Elt1 As Variant
Dim Arr1(), P As String, F As String
Dim Répertoire As String, S As String
Dim A As Integer, Sh As Worksheet, B As Integer

'Chemin à adapter selon où se trouvent tes fichiers
'J'ai supposé qu'ils étaient tous dans le même répertoire
Répertoire = "c:UsersDMDocuments"

'Liste des cellules à récupérer
Arr = Array("G9", "G13", "G15", "G17", "G19", _
"V9", "AG9", "O13", "R13", "Z13", "AC13")

'L'index des fichiers (le x, y, z) dans le nom des fichiers
'Tous tes fichiers s'appellent : "Delegat" auquel s'ajoute l'index
Arr1 = Array(1, 2, 3) 'Tu adaptes les index au besoin selon
'ton application

'Feuille où les données seront copiées
Set Sh = ThisWorkbook.Sheets("Feuil1") 'A adapter au besoin

Application.ScreenUpdating = False
'Une boucle sur tous les fichiers
For Each Elt In Arr1
'Chemin où est le fichier
'J'ai supposé que tes fichiers étaient dans
'le même répertoire
P = Répertoire
'Nom du fichier
F = "Delegat" & Elt & ".xls"
'Le nom de la feuille où sont les données dans chaque classeur
'J'ai supposé que le nom de l'onglet de la feuille était la même
S = "Feuil1"

'Un boucle sur la plage de cellules à récupérer
With Sh
A = .Range("A65536").End(xlUp).Row + 1
B = 1
For Each Elt1 In Arr
' nom feuille à adapter
.Range("A" & A).Offset(, B - 1) = GetValue(P, F, S, Elt1)
B = B + 1
Next
End With
Next
Application.ScreenUpdating = True
End Sub

'------------------------------
Private Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
'------------------------------






--
MichD
--------------------------------------------


"Philippe" bonjour

J'ai un certains nombre de fichiers mais tous commencent par delegat_ et je
voudrais dans ces fichiers récupérer des données pour faire une synthese
dans un nouveau fichier
Dans les fichiers delegat_x , delegat_y,delegat_z je voudrais récupérer des
données en G9,G13,G15,G17,G19,V9,AG9,O13,R13,Z13,AC13 et mettre les valeurs
dans un nouveau fichier delegat_date avec une ligne par fichier delegat_x ,
delegat_y,delegat_z
je ne connais pas les macros alors si vous pouviez m'aider
merci d'avance
Cordialement
Philippe
Philippe
Le #22580491
bonjour
bonjour

je teste actuellement la solution de michdenis et cela correspond bien à ce
que j'attends. Juste un petit soucis j'ai une cellule avec exemple 52.1 et
elle devient 52,1
Pourrais-ton avoir dans la 1ere colonne le nom des fichiers qui
correspondent aux lignes
Encore merci de cette aide





"michdenis" i6vh25$3vg$
Bonjour,

Dans ton fichier date où tu dois récupérer les données :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Tu insères un module : Menu / insertion / module
Tu y copies tout ce qui suit.

L'Exécution de la macro "Remplir_Le_Tableau" récupère toutes
les données dans devoir ouvrir le fichier source.

J'ai supposé que :
La racine du nom de chaque fichier est identique : "Delegat"
L'index x, y, z a été défini comme un chiffre de 1 à 3, c'est à adapter
selon ceux des vrais fichiers
L'onglet de la feuille où sont les données de chaque fichier a le même nom
"Feuil1"
Tu dois adapter le nom du répertoire selon ton environnement.

'------------------------------
Sub Remplir_Le_Tableau()
Dim Arr(), Elt As Variant, Elt1 As Variant
Dim Arr1(), P As String, F As String
Dim Répertoire As String, S As String
Dim A As Integer, Sh As Worksheet, B As Integer

'Chemin à adapter selon où se trouvent tes fichiers
'J'ai supposé qu'ils étaient tous dans le même répertoire
Répertoire = "c:UsersDMDocuments"

'Liste des cellules à récupérer
Arr = Array("G9", "G13", "G15", "G17", "G19", _
"V9", "AG9", "O13", "R13", "Z13", "AC13")

'L'index des fichiers (le x, y, z) dans le nom des fichiers
'Tous tes fichiers s'appellent : "Delegat" auquel s'ajoute l'index
Arr1 = Array(1, 2, 3) 'Tu adaptes les index au besoin selon
'ton application

'Feuille où les données seront copiées
Set Sh = ThisWorkbook.Sheets("Feuil1") 'A adapter au besoin

Application.ScreenUpdating = False
'Une boucle sur tous les fichiers
For Each Elt In Arr1
'Chemin où est le fichier
'J'ai supposé que tes fichiers étaient dans
'le même répertoire
P = Répertoire
'Nom du fichier
F = "Delegat" & Elt & ".xls"
'Le nom de la feuille où sont les données dans chaque classeur
'J'ai supposé que le nom de l'onglet de la feuille était la même
S = "Feuil1"

'Un boucle sur la plage de cellules à récupérer
With Sh
A = .Range("A65536").End(xlUp).Row + 1
B = 1
For Each Elt1 In Arr
' nom feuille à adapter
.Range("A" & A).Offset(, B - 1) = GetValue(P, F, S, Elt1)
B = B + 1
Next
End With
Next
Application.ScreenUpdating = True
End Sub

'------------------------------
Private Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
'------------------------------






--
MichD
--------------------------------------------


"Philippe" discussion : i6v9f4$kpa$
bonjour

J'ai un certains nombre de fichiers mais tous commencent par delegat_ et
je
voudrais dans ces fichiers récupérer des données pour faire une synthese
dans un nouveau fichier
Dans les fichiers delegat_x , delegat_y,delegat_z je voudrais récupérer
des
données en G9,G13,G15,G17,G19,V9,AG9,O13,R13,Z13,AC13 et mettre les
valeurs
dans un nouveau fichier delegat_date avec une ligne par fichier delegat_x
,
delegat_y,delegat_z
je ne connais pas les macros alors si vous pouviez m'aider
merci d'avance
Cordialement
Philippe

michdenis
Le #22580811
Pour le problème de la virgule à la place du point :
Application.Substitute(GetValue(P, F, S, Elt1), ",", ".")
Cette ligne de code va affecter toutes les données...

La question : Est-ce un problème avec une donnée seulement ou
toutes les données de la ligne ? Dans ton fichier recevant les données
est-ce que le format de la cellule est "Texte" ou "Standard" ?

Je n'ai pas tout compris, mais essaie ce qui suit :

Sub Remplir_Le_Tableau()
Dim Arr(), Elt As Variant, Elt1 As Variant
Dim Arr1(), P As String, F As String
Dim Répertoire As String, S As String
Dim A As Integer, Sh As Worksheet, B As Integer

'Chemin à adapter selon où se trouvent tes fichiers
'J'ai supposé qu'ils étaient tous dans le même répertoire
Répertoire = "c:UsersDMDocuments"

'Liste des cellules à récupérer
Arr = Array("G9", "G13", "G15", "G17", "G19", _
"V9", "AG9", "O13", "R13", "Z13", "AC13")

'L'index des fichiers (le x, y, z) dans le nom des fichiers
'Tous tes fichiers s'appellent : "Delegat" auquel s'ajoute l'index
Arr1 = Array(1, 2, 3) 'Tu adaptes les index au besoin selon
'ton application

'Feuille où les données seront copiées
Set Sh = ThisWorkbook.Sheets("Feuil1") 'A adapter au besoin

Application.ScreenUpdating = False
'Une boucle sur tous les fichiers
For Each Elt In Arr1
'Chemin où est le fichier
'J'ai supposé que tes fichiers étaient dans
'le même répertoire
P = Répertoire
'Nom du fichier
F = "Delegat" & Elt & ".xls"
'Le nom de la feuille où sont les données dans chaque classeur
'J'ai supposé que le nom de l'onglet de la feuille était la même
S = "Feuil1"

'Un boucle sur la plage de cellules à récupérer
With Sh
A = .Range("A65536").End(xlUp).Row + 1
.Range("A" & A) = F
B = 0
For Each Elt1 In Arr
' nom feuille à adapter
.Range("A" & A).Offset(, B) = _
Application.Substitute(GetValue(P, F, S, Elt1), ",", ".")
B = B + 1
Next
End With
Next
Application.ScreenUpdating = True
End Sub

'------------------------------
Private Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
'------------------------------


--
MichD
--------------------------------------------


"Philippe" bonjour
bonjour

je teste actuellement la solution de michdenis et cela correspond bien à ce
que j'attends. Juste un petit soucis j'ai une cellule avec exemple 52.1 et
elle devient 52,1
Pourrais-ton avoir dans la 1ere colonne le nom des fichiers qui
correspondent aux lignes
Encore merci de cette aide





"michdenis" i6vh25$3vg$
Bonjour,

Dans ton fichier date où tu dois récupérer les données :
Tu ouvres la fenêtre de l'éditeur de code : Alt + F11
Tu insères un module : Menu / insertion / module
Tu y copies tout ce qui suit.

L'Exécution de la macro "Remplir_Le_Tableau" récupère toutes
les données dans devoir ouvrir le fichier source.

J'ai supposé que :
La racine du nom de chaque fichier est identique : "Delegat"
L'index x, y, z a été défini comme un chiffre de 1 à 3, c'est à adapter
selon ceux des vrais fichiers
L'onglet de la feuille où sont les données de chaque fichier a le même nom
"Feuil1"
Tu dois adapter le nom du répertoire selon ton environnement.

'------------------------------
Sub Remplir_Le_Tableau()
Dim Arr(), Elt As Variant, Elt1 As Variant
Dim Arr1(), P As String, F As String
Dim Répertoire As String, S As String
Dim A As Integer, Sh As Worksheet, B As Integer

'Chemin à adapter selon où se trouvent tes fichiers
'J'ai supposé qu'ils étaient tous dans le même répertoire
Répertoire = "c:UsersDMDocuments"

'Liste des cellules à récupérer
Arr = Array("G9", "G13", "G15", "G17", "G19", _
"V9", "AG9", "O13", "R13", "Z13", "AC13")

'L'index des fichiers (le x, y, z) dans le nom des fichiers
'Tous tes fichiers s'appellent : "Delegat" auquel s'ajoute l'index
Arr1 = Array(1, 2, 3) 'Tu adaptes les index au besoin selon
'ton application

'Feuille où les données seront copiées
Set Sh = ThisWorkbook.Sheets("Feuil1") 'A adapter au besoin

Application.ScreenUpdating = False
'Une boucle sur tous les fichiers
For Each Elt In Arr1
'Chemin où est le fichier
'J'ai supposé que tes fichiers étaient dans
'le même répertoire
P = Répertoire
'Nom du fichier
F = "Delegat" & Elt & ".xls"
'Le nom de la feuille où sont les données dans chaque classeur
'J'ai supposé que le nom de l'onglet de la feuille était la même
S = "Feuil1"

'Un boucle sur la plage de cellules à récupérer
With Sh
A = .Range("A65536").End(xlUp).Row + 1
B = 1
For Each Elt1 In Arr
' nom feuille à adapter
.Range("A" & A).Offset(, B - 1) = GetValue(P, F, S, Elt1)
B = B + 1
Next
End With
Next
Application.ScreenUpdating = True
End Sub

'------------------------------
Private Function GetValue(path, file, sheet, ref)
' Retrieves a value from a closed workbook
Dim arg As String
' Make sure the file exists
If Right(path, 1) <> "" Then path = path & ""
If Dir(path & file) = "" Then
GetValue = "File Not Found"
Exit Function
End If
' Create the argument
arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("A1").Address(, , xlR1C1)
' Execute an XLM macro
GetValue = ExecuteExcel4Macro(arg)
End Function
'------------------------------






--
MichD
--------------------------------------------


"Philippe" discussion : i6v9f4$kpa$
bonjour

J'ai un certains nombre de fichiers mais tous commencent par delegat_ et
je
voudrais dans ces fichiers récupérer des données pour faire une synthese
dans un nouveau fichier
Dans les fichiers delegat_x , delegat_y,delegat_z je voudrais récupérer
des
données en G9,G13,G15,G17,G19,V9,AG9,O13,R13,Z13,AC13 et mettre les
valeurs
dans un nouveau fichier delegat_date avec une ligne par fichier delegat_x
,
delegat_y,delegat_z
je ne connais pas les macros alors si vous pouviez m'aider
merci d'avance
Cordialement
Philippe

Publicité
Poster une réponse
Anonyme