Report de données d'un fichier vers un autre

[David2Coree]

Bonsoir à tous,
Je viens poster ce message car j'ai besoin de votre aide. En effet, j'aimerai pouvoir reporter des données par macro de plusieurs fichiers excel qui se trouveront dans le même dossier et qui ont la même mise en forme.
Je dois envoyer le fichier forumxls_fiche1 à des personnes qui devront le remplir selon leur département puis me le retourner. Ensuite de ces fichiers, je dois récupérer les valeurs des colonnes G, H, J, K, O et P et les insérer dans mon fichier tabrecap selon aussi leur département. J'ai un délai très court pour parvenir aux résultats escompter, c'est pour cela que je me tourne vers vous afin que vous m'aidiez à trouver une solution en Visual Basic.
J'avais trouvé une macro dans ce forum qui faisait presque ce que je recherchais mais je n'arrive pas à l'adapter pour mes besoins (voir le fichier zip). Pardon au créateur de la macro, mais je ne me rappelle plus dans quel post il se trouvait.
Croyez-vous que c'est faisable mon projet ?
D'avance un grand merci à ceux qui se pencheront sur mon problème.
PS : Je suis uniquement sur MS Office 2003
Cordialement.
David

 

[Staple1600]

Re : Report de données d'un fichier vers un autre

Bonsoir

Pardon au créateur de la macro, mais je ne me rappelle plus dans quel post il se trouvait.

Juste pour saluer Catrice
(qui semble être l'auteur dont tu as oublié le nom)

Lien supprimé

Sinon pour répondre à ta question
Oui c'est très largement faisable.

Surtout si on part du code de Catrice.

Premièreadaptation à partir de l'existant

Sub Test()[COLOR=Green] 'code origine : Catrice[/COLOR]
Dim t_f, j As Long
t_f = Array(22, 29, 35, 56)
Application.ScreenUpdating = False
        Chemin = "C:\Temp" 'Définit le chemin des fichiers.
        Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin) 'Définit le dossier d'ouverture des plannings
        For Each Fichier In Dossier.Files 'Boucle sur les fichiers contenus dans le dossier
            If Right(Fichier.Name, 3) = "xls" And Fichier.Name <> ThisWorkbook.Name Then 'Si ce sont des ".xls" et qu'ils sont differents de ce classeur alors ...
                Set MonClass = Workbooks.Open(Chemin & "\" & Fichier.Name) 'On ouvre le classeur qu'on associe à "MonClass"
                For j = LBound(t_f) To UBound(t_f)
             [COLOR=Green]   'ici exemple pour la colonne G[/COLOR]
                MonClass.Sheets(CStr(t_f(j))).Range("G4:G" & MonClass.Sheets(CStr(t_f(j))).Range("G65536").End(xlUp).Row).Copy ThisWorkbook.Sheets(CStr(t_f(j))).Range("A65536").End(xlUp)(2)
                Next
                MonClass.Close False
              Set MonClass = Nothing
            End If
        Next
Application.ScreenUpdating = True
End Sub

Je te laisse compléter la suite pour H, J, K, O et P

 

[David2Coree]

Re : Report de données d'un fichier vers un autre

Bonjour Staple1600,

D'abord merci pour ta réponse. J'ai essayé tes lignes de commande mais j'ai un message d'erreur VB 1004 : impossible de modifier une cellule fusionnée. Et pourtant dans tous les onglets, à la ligne 4, aucunes cellules ne sont fusionnées.
Voici la macro avec tes instructions, ai-je fait une erreur quelque part ?

Sub recupdonnees()
'
' recupdonnees Macro
'

Dim t_f, j As Long
t_f = Array(22, 29, 35, 56)
Application.ScreenUpdating = False
Chemin = "U:\Excel\Aide_service\Qualite\test recup donnees" 'Définit le chemin des fichiers.
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder("U:\Excel\Aide_service\Qualite\test recup donnees") 'Définit le dossier d'ouverture des plannings
For Each Fichier In Dossier.Files 'Boucle sur les fichiers contenus dans le dossier
If Right(Fichier.Name, 3) = "xls" And Fichier.Name <> ThisWorkbook.Name Then 'Si ce sont des ".xls" et qu'ils sont differents de ce classeur alors ...
Set MonClass = Workbooks.Open(Chemin & "\" & Fichier.Name) 'On ouvre le classeur qu'on associe à "MonClass"
For j = LBound(t_f) To UBound(t_f)
'ici exemple pour la colonne G
MonClass.Sheets(CStr(t_f(j))).Range("G4:G" & MonClass.Sheets(CStr(t_f(j))).Range("G65536").End(xlUp).Row).Copy ThisWorkbook.Sheets(CStr(t_f(j))).Range("A65536").End(xlUp)(2)
Next
MonClass.Close False
Set MonClass = Nothing
End If
Next
Application.ScreenUpdating = True

'
End Sub

Dans l'attente de ta réponse, je te souhaite une bonne journée.
Cordialement
David

 

[David2Coree]

Re : Report de données d'un fichier vers un autre

Bonjour à tous,

J'ai une modification à faire sur mon projet. En effet je ne dois plus avoir un seul fichier contenant 4 onglets mais 4 fichiers avec un seul onglet pour le fichier forumxls_fiche1.
Tous les fichiers seront regroupés dans un seul et même dossier.
Toutes les fiches navettes auront la même synthaxe.
Le fichier récap doit seulement récupérer 3 valeurs de cellule :
Je dois récupérer dans le forumxls_fiche1 les valeurs de la colonne H, O et P
Et dans le fichier tabrecap, les valeurs récupérées doivent s'insérer respectivement dans les colonnes B,C,D.

Merci à tous pour l'aide que vous me procurerez.

 

[David2Coree]

Re : Report de données d'un fichier vers un autre

Bonjour à tout le forum,

Personne ne peut venir à mon secour ?
Mes compétences en VBA sont très basses et je n'arrive pas à extraires ces données.

Merci pour votre aide.

 

[David2Coree]

Re : Report de données d'un fichier vers un autre

Bonjour, bonjour à tous !

Je reviens vers vous au sujet de mon problème d'importation de données de 4 fichiers excel vers 1 seul fichier.
Ci-joint les fichiers excel :
- le fichier zip est le tableau de récapitulation des données des 4 autres fichiers ( je suis désolé je n'ai pas pu insérer le 4ième car j'ai atteint le nombre maximum de fichiers mais je suis sûr que vous comprendrez la logique des 3 autres fichiers )

Mon but est de récupérer les valeurs des cellules des colonnes H, P et Q qui se trouvent dans les fichiers retour expert comptable dans le fichier Tableau de suivi respectivement dans les colonnes B, C et D.

Après, de longues, longues heures de recherche sur ce forum (que je tiens à préciser que c'est une mine d'or d'informations pratique sur excel), je pense avoir trouvé la macro dont j'ai besoin (voici le lien https://www.excel-downloads.com/threads/macro-importer-plage-de-donnee-excel-vers-excel.121806/ ) proposé par Michel_M.

Donc j'ai essayé de l'adapter à mes fichiers, j'ai donné un nom à ma plage de données sur les 4 fichiers NomTISS =Feuil1!$H$5:$H$204;Feuil1!$P$5:$Q$204
Ensuite j'ai modifé dans le programme VB, le nom de la plage :

Const compil As String = "Tableau de suivi de la convention de partenariat avec les EC.xls" 'fichier de regroupement. nom à adapter
Const plage As String = "NomTISS" 'plage à copier dans cible
Public chemin As String

Sub chercher()
Dim fichier As String
Dim ligne As Long
'
chemin = ThisWorkbook.Path & "\"
ChDir chemin

Application.ScreenUpdating = False
ligne = 5
fichier = Dir("*.xls")
While fichier <> ""
If fichier <> compil Then
extraire fichier, ligne
ligne = Range("A65536").End(xlUp).Row + 1
End If
fichier = Dir
Wend
End Sub

Sub extraire(fich As String, lig As Long)
Dim source As Object
Dim requete As Object
Dim texte_SQL As String
test = plage
'connexion ADO au fichier
Set source = CreateObject("ADODB.Connection")
source.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & chemin & fich & ";Extended Properties=""Excel 8.0;HDR=no;"";"

'exerce la requete ADO sur la donnée à recopier
texte_SQL = "SELECT * FROM [" & plage & "] "
Set requete = CreateObject("ADODB.Recordset")
Set requete = source.Execute(texte_SQL)

'recopie les données du fichier
Cells(lig, 5).CopyFromRecordset requete

'f'erme la connexion ADO
Set requete = Nothing
Set source = Nothing


End Sub


Lorsque j'exécute la macro afin de voir les effets du prog, Set requete = source.Execute(texte_SQL) ==> Cette ligne me génère un message d'erreur VB : "Erreur d'exécution '-2147217865 (80040e37) Le moteur de base de données Microsoft Jet n'a pas pu trouver l'objet 'NomTISS'...." Et si je retourne sur les fichiers retour expert comptable dans Insertion / Nom / Définir 'NomTISS' est bien présent.

Pouvez-vous me dire où j'ai fais une erreur SVP et si le programme est bien adapté à mes besoin ?

D'avance merci à tous ceux qui auront lu mon message jusqu'au bout !!!!

Très bonne journée.