Importer des données de plusieurs fichiers, sous condition

Résolu/Fermé

Bibi33130 Messages postés 4 Date d'inscription vendredi 4 mars 2016 Statut Membre Dernière intervention 7 mars 2016 - 4 mars 2016 à 11:35
Bibi33130 Messages postés 4 Date d'inscription vendredi 4 mars 2016 Statut Membre Dernière intervention 7 mars 2016 - 7 mars 2016 à 12:17

Bonjour à tous,

Voilà cela fait quelques jours que je me suis mis au VBA, j'ai pu récolter beaucoup d'informations sur le forum mais je bloque encore sur ce code.

Voici mon problème:
Mon doc principal doit récupérer des données de plusieurs fichiers situés dans un même répertoire. Il faut récupérer les données des mêmes cellules pour tous les fichiers, mais à une condition: qu'une cellule spécifique (B26) contienne quelque chose (à l'heure actuelle mon code importe même lorsque les cellules sont vides du coup cela me met plein de 0 dans mon tableau..).
Les données récoltées dans un fichier doivent être collées dans mon fichier principal par ligne (exemple: données du fichier 1 collées en A13, B13 ,C13) et ainsi de suite (exemple: données du fichier 2 collées en A14, B14 ,C14..).
Enfin dans l'idéal, j'aimerai que la macro n'aille chercher qu'une seule fois les données d'un même fichier, car j'ai mis une mise a jour toutes les N minutes, et je ne veux pas importer plusieurs fois les mêmes données.

Voici mon code (l'import des données fonctionne mais pas la condition):


Sub exportdonnées()

Dim lig As Integer, p As String, nomfich As String
Application.ScreenUpdating = False 'fige l'écran (pour accélérer)
Range("A13:D65536").ClearContents 'efface la plage de restitution
lig = 13 'restitution à partir de la ligne 13
p = ThisWorkbook.Path & "\"
nomfich = Dir(p & "*.xls") '1er fichier du dossier
While nomfich <> ""

If nomfich <> ThisWorkbook.Name And "[" & nomfich & "]Article_Livrable et Prestations!B26" <> "" Then

Cells(lig, 1).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!G17"
Cells(lig, 2).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B26"
Cells(lig, 3).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!D4"
Cells(lig, 4).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B20"

lig = lig + 1


Else: Exit Sub
End If

nomfich = Dir 'fichier suivant du dossier
Wend

End Sub

J'espère que j'ai été assez clair dans la description du problème.
Un grand merci par avance pour votre aide!! :)

A voir également:

Importer des données de plusieurs fichiers, sous condition
Wetransfer gratuit fichiers lourd - Guide
Renommer plusieurs fichiers - Guide
Excel cellule couleur si condition texte - Guide
Explorateur de fichiers - Guide
Importer contact - Guide

4 réponses

Réponse 1 / 4

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
4 mars 2016 à 14:28

Bonjour

essaies de remplacer

If nomfich <> ThisWorkbook.Name And "[" & nomfich & "]Article_Livrable et Prestations!B26" <> "" Then

Cells(lig, 1).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!G17"
Cells(lig, 2).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B26"
Cells(lig, 3).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!D4"
Cells(lig, 4).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B20"

par

If nomfich <> ThisWorkbook.Name Then
Lieu = nomfich & "]Article_Livrable et Prestations'!"

Cells(lig, 1) = ExecuteExcel4Macro("'" & Lieu & "R17C7")
Cells(lig, 2) = ExecuteExcel4Macro("'" & Lieu & "R26C2")
Cells(lig, 3) = ExecuteExcel4Macro("'" & Lieu & "R4C4")
Cells(lig, 4) = ExecuteExcel4Macro("'" & Lieu & "R20C2")

Non vérifié car il n'y a pas de classeur source et cible en pièce jointe
--
Michel

Réponse 2 / 4

Bibi33130 Messages postés 4 Date d'inscription vendredi 4 mars 2016 Statut Membre Dernière intervention 7 mars 2016
4 mars 2016 à 15:08

Bonjour Michel,

Merci de ta réponse. Malheureusement je viens d'essayer et ça ne fonctionne pas.

Je met mes fichiers en pièces jointes.

Par contre tu n'intègre pas la condition d'avoir obligatoirement une cellule contenant une donnée avant de copier/coller ?

https://www.cjoint.com/c/FCeoeuZTHYj
https://www.cjoint.com/c/FCeohpiQj1j
https://www.cjoint.com/c/FCeoigREjLj

Réponse 3 / 4

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
Modifié par michel_m le 4/03/2016 à 15:49

pour prendre en compte B26 vide (il renvoie zéro)
Tu caches dans un coin une cellule nommée "test"

If nomfich <> ThisWorkbook.Name Then
    Range("test").Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B26"
    If Range("test") <> 0 Then
        Cells(lig, 2).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B26"
        Cells(lig, ....

Un remarque importante

Evite au maximum les cellules fusionnées qui causent un sacré B...!!!
je n'ai pas regarder mais de mémoire, XL4ne connait les cellules fusionnées

Par ex pour centrer un texte sur B26:C26

Michel

michel_m Messages postés 16603 Date d'inscription lundi 12 septembre 2005 Statut Contributeur Dernière intervention 16 décembre 2023 3 303
7 mars 2016 à 08:44

MERCI!

De rien...

Bibi33130 Messages postés 4 Date d'inscription vendredi 4 mars 2016 Statut Membre Dernière intervention 7 mars 2016
7 mars 2016 à 09:55

Bonjour Michel,

Je viens juste de voir ton message, j'essaye d'appliquer cela et te tiens informé!

Merci!!

Réponse 4 / 4

Bibi33130 Messages postés 4 Date d'inscription vendredi 4 mars 2016 Statut Membre Dernière intervention 7 mars 2016
7 mars 2016 à 12:17

J'ai trouvé un code plus approprié à mon problème qui fonctionne!
En tout cas merci pour ton aide et ta réactivité Michel !!
Bonne journée

Dim lig As Integer, p As String, nomfich As String
Application.ScreenUpdating = False 'fige l'écran (pour accélérer)
Range("A13:D65536").ClearContents 'efface la plage de restitution
lig = 13 'restitution à partir de la ligne 13
p = ThisWorkbook.Path & "\"
nomfich = Dir(p & "*.xls") '1er fichier du dossier
    Do While nomfich <> ""
        If nomfich <> ThisWorkbook.Name Then
            Cells(lig, 1).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!G17"
            Cells(lig, 2).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B26"
            Cells(lig, 3).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!D4"
            Cells(lig, 4).Formula = "='" & p & "[" & nomfich & "]Article_Livrable et Prestations'!B20"

 nomfich = Dir 'fichier suivant du dossier
    Loop
For lig = Range("A65536").End(xlUp).Row To 13 Step -1
    If Cells(lig, 2) = 0 Then Rows(lig).Delete
Next lig
Application.ScreenUpdating = True
End Sub

Discussions similaires

comment donner les droits sur fichier partage

Question PIX

Discussions similaires

Newsletters