Import de données depuis plusieurs classeurs

Le 04/03/2022 à 09:59

Bonjour à tous !

J'espère que tout le monde se porte bien.

Je viens vers vous dans le but d'obtenir un petit conseil sur une des macros que je tente (tant bien que mal) de faire fonctionner.
En quelques mots, mon objectif est simple (ou presque) : j'ai un premier classeur qui sert à compiler toutes les données de différents clients. Le souci est que chaque client me renvoie son propre classeur avec des données que je dois mettre à jour et je dois reporter chacune des données dans le 1er classeur.... Long !

Je tente donc d'optimiser mon travail via le VBA qui me sauve bien des heures depuis quelques temps.
Dans le 1er classeur qui compile tout j'ai une liste des clients qui doivent me renvoyer des données et comme chaque client me renvoie un fichier qui s'appelle uniquement par le numéro du client j'ai pensé qu'une petite boucle me permettrait de faire tout ça.
Je précise également que chaque client a reçu de ma part le fichier nommé par son numéro client et que les cellules à me compléter sont déjà nommées pour que je puisse rapidement les importer.

J'ai réussi à faire fonctionner la macro, dans le sens où Excel va bien me chercher les fichiers désirés, les ouvrent, et copie les données dans mon classeur mais j'ai une erreur que je n'arrive pas à identifier... La 1ere ligne s'écrit normalement mais les suivantes s'écrivent toutes les 2 lignes et ne respectent pas (c'est mon analyse) le i de ma boucle...

Voici le code que j'ai pu réaliser jusque-là :

Sub recupdonneespubli()

Dim source As Workbook, cible As Workbook, bdd As Worksheet, tbl As ListObject, i As Long
Dim refclient As String
Set source = ThisWorkbook
Set bdd = ThisWorkbook.Worksheets("Recap")
Set tbl = bdd.ListObjects(1)

Application.ScreenUpdating = False

For i = 1 To tbl.ListRows.Count
    refclient = tbl.ListRows(i).Range.Cells(1).Value
    Set cible = Workbooks.Open(ThisWorkbook.Path & "\" & refclient & ".xlsx")
    On Error Resume Next

    Set source = ActiveWorkbook

    tbl.ListRows(i).Range.Cells(i, 3).Value = cible.Worksheets("MAJ CLIENT").Range("numSiret").Value
    tbl.ListRows(i).Range.Cells(i, 4).Value = cible.Worksheets("MAJ CLIENT").Range("nomDirecteur").Value
    tbl.ListRows(i).Range.Cells(i, 5).Value = cible.Worksheets("MAJ CLIENT").Range("mailClient").Value

    cible.Close

Next i

Application.ScreenUpdating = True
MsgBox ("Terminé !")

End Sub

et voici le résultat que j'obtient...

mon probleme

Je vous joins bien évidemment à mon message les fichiers que j'utilise..

9test.xlsm (20.25 Ko)
81234567a.xlsx (8.62 Ko)
71234567b.xlsx (8.60 Ko)
71234567c.xlsx (8.62 Ko)
51234567d.xlsx (8.61 Ko)

D'avance merci pour votre aide !

Bonne journée.

Sam.

Le 04/03/2022 à 10:21

Bonjour,

Tout les fichiers ont la même structures ? si Oui pq ne passer par power query ?

Les fichiers sont de le même dossier ?

Le 04/03/2022 à 11:01

Bonjour Valentin !

Merci de ta réponse.

Oui tous les fichiers envoyés au client auront la même structure. Après, j'ai bien pensé à PowerQuery, mais au final j'ai peur que ça complique mon process. En fait, le fichier des clients ne ressemblera pas exactement au modèle fourni et ne sera pas sous forme d'un tableau structuré "classique". Mon fichier est un peu plus poussé graphiquement dans le but d'avoir une présentation plus agréable pour le client et c'est la raison pour laquelle je me suis tourné vers la solution des plages nommées plutôt qu'avec PowerQuery.

Dans le code que j'ai pu réaliser jusque là, le fonctionnement me va bien cependant, c'est juste cette histoire de ligne passée qui m'embête. Je ne comprends pas pourquoi une ligne est sautée à chaque nouvel enregistrement.. As-tu une idée ?

Et oui j'ai conçu la 1ere version avec les fichiers cibles dans le même dossier mais si d'aventure ,j'avais besoin qu'ils se trouvent ailleurs, je pense pouvoir régler le souci avec une varible qui récupère un msoFileDialogFolderPicker ;)

D'avance merci ;)

Le 04/03/2022 à 12:36

Comme tu le sens,

Si jamais tu veux passer le pas pour Power query fais moi signe. Pour le VBA je passe mon tour.

Bon courage.

Le 04/03/2022 à 13:02

Après je reste ouvert aux propositions et surtout à ma montée en compétence sur Power Query (qui me semble hyper puissant). Le truc c'est que j'imagine qu'il va falloir que mes fichiers envoyés au clients soient sous la forme d'un tableau structuré ? Sinon PQuery ne remontera rien comme données..

Chose sur laquelle je n'ai pas la main..

En tout cas si quelqu'un a une solution pour la partie Vba je suis preneur 😁

Le 04/03/2022 à 13:23

Ce n'est pas obligatoire, préconisé mais pas obligatoire. Tout dépend de la forme et la structure ? Un exemple sans données confidentielles de l'un des fichier pourrait me permettre de vous montrer si cela est possible ou non ?

Le 04/03/2022 à 15:30

bonjour le forum

je partage une proposition?

Utilise le fichier « Test » pour importer vos données clients du dossier « MAJ » sans l’ouvrir

21import.zip (36.97 Ko)
Le 04/03/2022 à 15:48

Ca me parait compliqué...

Mais pas de soucis, je viens de trouver ma coquille. Je mettais un "List.Rows(i)." en trop ce qui créait forcément un décalage...

Je te remercie pour ta réactivité en tout cas et au plaisir de pouvoir travailler avec toi de nouveau ^^

Pour info, je met en copie le code du projet fonctionnel, au cas où ça intéresse quelqu'un :)

A plus !

Sub recupdonneespubli()

Dim source As Workbook, cible As Workbook, bdd As Worksheet, tbl As ListObject, i As Long
Dim refclient As String
Set source = ThisWorkbook
Set bdd = ThisWorkbook.Worksheets("Recap")
Set tbl = bdd.ListObjects(1)

Application.ScreenUpdating = False

For i = 1 To tbl.ListRows.Count
    refclient = tbl.ListRows(i).Range.Cells(1).Value
    Set cible = Workbooks.Open(ThisWorkbook.Path & "\" & refclient & ".xlsx")
    On Error Resume Next

    Set source = ActiveWorkbook

    tbl.Range.Cells(i + 1, 3).Value = cible.Worksheets("MAJ CLIENT").Range("numSiret").Value
    tbl.Range.Cells(i + 1, 4).Value = cible.Worksheets("MAJ CLIENT").Range("nomDirecteur").Value
    tbl.Range.Cells(i + 1, 5).Value = cible.Worksheets("MAJ CLIENT").Range("mailClient").Value

    cible.Close

Next

Application.ScreenUpdating = True
MsgBox ("Terminé !")

End Sub

Sam

Le 04/03/2022 à 16:00

Oh merci Chindou ! Je n'avais pas vu ta réponse...

Je vais prendre le temps de l'étudier car tu utilises un certain nombre de principes qui me sont inconnus ^^ Mais je suis curieux de décortiquer tout ça et de pouvoir m'en servir pour améliorer le code que j'ai pu faire !

En tout cas merci à toi également de ta proposition que je m'empresse d'ouvrir :)

Le 04/03/2022 à 21:42

bonsoir le forum bonsoir RopperLimp

Dans le module compiler_clients.
Remplace la ligne suivante: MsgBox "Sélectionner le dossier des collèges"
Par:
MsgBox "Sélectionner le dossier MAJ" ' dossier des fichiers clients

Rechercher des sujets similaires à "import donnees classeurs"