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
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
A voir également:
- Importer des données de plusieurs fichiers, sous condition
- Renommer plusieurs fichiers - Guide
- Excel cellule couleur si condition texte - Guide
- Wetransfer gratuit fichiers lourd - Guide
- Explorateur de fichiers - Guide
- Reinstaller windows sans perte de données - Guide
4 réponses
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 306
4 mars 2016 à 14:28
4 mars 2016 à 14:28
Bonjour
essaies de remplacer
par
Non vérifié car il n'y a pas de classeur source et cible en pièce jointe
--
Michel
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
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
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
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
michel_m
Messages postés
16603
Date d'inscription
lundi 12 septembre 2005
Statut
Contributeur
Dernière intervention
16 décembre 2023
3 306
Modifié par michel_m le 4/03/2016 à 15:49
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"
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
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 306
7 mars 2016 à 08:44
7 mars 2016 à 08:44
MERCI!
De rien...
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
7 mars 2016 à 09:55
Bonjour Michel,
Je viens juste de voir ton message, j'essaye d'appliquer cela et te tiens informé!
Merci!!
Je viens juste de voir ton message, j'essaye d'appliquer cela et te tiens informé!
Merci!!
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
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
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