Importer des données de plusieurs fichiers, sous condition [Résolu/Fermé]

Signaler
Messages postés
4
Date d'inscription
vendredi 4 mars 2016
Statut
Membre
Dernière intervention
7 mars 2016
-
Messages postés
4
Date d'inscription
vendredi 4 mars 2016
Statut
Membre
Dernière intervention
7 mars 2016
-
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!! :)

4 réponses

Messages postés
16477
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
10 juin 2021
3 189
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
Messages postés
4
Date d'inscription
vendredi 4 mars 2016
Statut
Membre
Dernière intervention
7 mars 2016

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
Messages postés
16477
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
10 juin 2021
3 189
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
Messages postés
16477
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
10 juin 2021
3 189
MERCI!

De rien...
Messages postés
4
Date d'inscription
vendredi 4 mars 2016
Statut
Membre
Dernière intervention
7 mars 2016

Bonjour Michel,

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

Merci!!
Messages postés
4
Date d'inscription
vendredi 4 mars 2016
Statut
Membre
Dernière intervention
7 mars 2016

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