Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Recuperations données dans fichiers

5 réponses
Avatar
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

5 réponses

Avatar
Philippe
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" a écrit dans le message de news:
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

Avatar
DanielCo
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" a écrit dans le message de news:
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

Avatar
michdenis
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" a écrit dans le message de groupe de 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
Avatar
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" a écrit dans le message de news:
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" a écrit dans le message de groupe de
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

Avatar
michdenis
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" a écrit dans le message de groupe de discussion : i70h1r$amj$
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" a écrit dans le message de news:
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" a écrit dans le message de groupe de
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