Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2010 Télécharger données autres classeurs dans un fichier excel en vba

B

BBDan

XLDnaute Nouveau
Bonjour,
J'ai un dossier nommé "Factures" dans lequel j'enregistre toutes mes factures clients.
Dans chaque facture, j'ai nommé des cellules spécifiques contenant des données que j'aimerais exploiter.
Je voudrais qu'Excel aille me chercher les données des cellules nommées dans chaque facture de ce dossier et me les rentre automatiquement dans mon fichier RECAP FACTURES en les triant par chantier.
Il faudrait qu'il crée une nouvelle ligne dès qu'une nouvelle facture est créée.
J'ai créé un bouton "Actualiser" pour effectuer cette macro mais j'avoue que je débute en macro et ne sais pas vraiment comment m'y prendre.
Je mets en pièce jointe un exemple de facture et mon tableau récap.
J'ai commencé une macro, mais j'ai besoin d'aide.
Merci d'avance.
 

Pièces jointes

  • 12040.FP19 CH H GUERIN PIERREFEU L2 S8.xls
    188 KB · Affichages: 17
  • RECAP FACTURES.xlsm
    16.2 KB · Affichages: 9
Solution
Cela dit VBA a prévu le coup, il suffit de remplacer l'apostrophe par... 2 apostrophes :
VB: 
    If fichier <> ThisWorkbook.Name Then
        fichier = Replace(fichier, "'", "''")
        form = "'" & chemin & "[" & fichier & "]FACTURE'!"
Testez les fichiers joints.
Trier par date Trier par votes

job75

XLDnaute Barbatruc
Bonsoir BBDan,

Téléchargez les fichiers joints dans le même dossier et exécutez cette macro :
VB: 
Sub Actualiser()
Dim chemin$, fichier$, a, b(), lig&, form$, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*")
a = Array("DATE", "N°FACT", "N°SITU", "CHANTIER", "LOT", "BASEHT", "AVT_1", "AVT_2", "AVT_3", "AVT_4", "AVT_5", "AVT_6", "AVT_7", "TOTALMARCHE", "FACTHT")
ReDim b(1 To 15)
lig = 3 '1ère ligne de restitution
Application.ScreenUpdating = False
On Error Resume Next
While fichier <> ""
    form = "'" & chemin & "[" & fichier & "]FACTURE'!"
    For i = 1 To 15
        b(i) = ExecuteExcel4Macro(form & a(i - 1))
        If Err Or IsError(b(i)) Then Err = 0: GoTo 1
    Next
    Cells(lig, 1).Resize(, 15) = b 'restitution sur 15 colonnes
    lig = lig + 1
1   fichier = Dir 'fichier suivant
Wend
Rows(lig & ":" & Rows.Count).Delete 'RAZ en dessous
Columns.AutoFit 'ajustement largeurs
End Sub
Les fichiers sources sont copiés tout en restant fermés.

Je m'occuperai de la colonne P quand vous nous direz ce qu'il faut y mettre

PS : le nom "N°SITU" n'existait pas, je l'ai créé et j'ai recréé aussi "AVT_1"..."AVT_7".

A+
 

Pièces jointes

  • RECAP FACTURES(1).xlsm
    21.6 KB · Affichages: 11
  • 12040.FP19 CH H GUERIN PIERREFEU L2 S8.xls
    185 KB · Affichages: 16
Dernière édition:
Vote positif 1 Vote négatif

job75

XLDnaute Barbatruc
Bonjour BBDan, le forum,

J'ai testé en traitant 100 fichiers sources (tous identiques) :

- avec la macro précédente => 2,4 secondes

- en ouvrant et fermant chaque fichier => 50 secondes.

A+
 
Vote positif 0 Vote négatif
B

BBDan

XLDnaute Nouveau
Waouh ! Chapeau Job75 ! Je suis ébahie devant tant de savoir.
Je vous remercie infiniment d'avoir passé du temps sur ce projet.
Ingénieux la mise en forme personnalisée pour N°SITU !
La macro fonctionne super bien pour la facture en PJ de mon 1er post, mais par exemple pour celle en pièce jointe, cela ne fonctionne pas.

En effet, chaque facture est différente : il y a des constantes comme DATE, N°FACT, CHANTIER, LOT, FACTHT
Mais il y a aussi des variables, comme pour les avenants (dans certaines factures, il n'y en a pas et dans d'autres il peut y en avoir une vingtaine), le N°SITU peut apparaître sur certaines factures et pas sur d'autres.
Je voudrais qu'Excel remplisse le tableau en fonction des cellules nommées qu'il trouve dans chaque facture.

Faut-il que le classeur RECAP FACTURE soit dans le même dossier que mes factures ?

Pour ce qui est de la colonne P, il faudrait qu'Excel calcule la différence entre le MONTANT TOTAL MARCHE HT et le MONTANT FACTURE HT.

Serait-il possible également d'automatiser le calcul du MONTANT TOTAL MARCHE HT en faisant la somme depuis MONTANT BASE HT jusqu'au dernier AVT ?

Je suis impatiente de découvrir vos conseils et vos solutions.
Encore un grand MERCI !
 

Pièces jointes

  • 12044.FP.19 HPP MAISON MED PLOT 3 S5 L22 SOLS COLLES.xls
    92.5 KB · Affichages: 3
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Voyez ce fichier (2), je pense que cette macro fait ce que vous souhaitez :
VB: 
Sub Actualiser()
Dim chemin$, fichier$, a, b(), lig&, form$, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*")
a = Array("DATE", "N°FACT", "N°SITU", "CHANTIER", "LOT", "BASEHT", "AVT_1", "AVT_2", "AVT_3", "AVT_4", "AVT_5", "AVT_6", "AVT_7", "TOTALMARCHE", "FACTHT")
ReDim b(1 To 16)
lig = 3 '1ère ligne de restitution
Application.ScreenUpdating = False
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        form = "'" & chemin & "[" & fichier & "]FACTURE'!"
        For i = 1 To 15
            b(i) = ExecuteExcel4Macro(form & a(i - 1))
            If IsError(b(i)) Then b(i) = Empty
            If i > 5 Then If Not IsNumeric(b(i)) Then b(i) = Empty 'sécurité
        Next
        If IsEmpty(b(14)) Then b(14) = b(6) + b(7) + b(8) + b(9) + b(10) + b(11) + b(12) + b(13)
        If b(14) = 0 Then b(14) = Empty
        If b(14) <> b(15) Then b(16) = b(14) - b(15) 'colonne N - colonne O
        If Application.CountA(b) Then
            Cells(lig, 1).Resize(, 16) = b 'restitution sur 16 colonnes
            lig = lig + 1
        End If
    End If
    fichier = Dir 'fichier suivant
Wend
On Error Resume Next
Rows(lig & ":" & Rows.Count).Delete 'RAZ en dessous
Columns.AutoFit 'ajustement largeurs
End Sub
En colonne P on obtient la différence entre la colonne N et la colonne O comme demandé mais cela me paraît bizarre, il faudrait à mon avis retrancher la somme de toutes les factures précédentes et ça ce n'est pas facile.

Comme déjà dit tous les fichiers doivent être placés dans le même dossier.
 

Pièces jointes

  • RECAP FACTURES(2).xlsm
    22.6 KB · Affichages: 10
  • 12040.FP19 CH H GUERIN PIERREFEU L2 S8.xls
    185 KB · Affichages: 8
  • 12044.FP.19 HPP MAISON MED PLOT 3 S5 L22 SOLS COLLES.xls
    88.5 KB · Affichages: 8
Dernière édition:
Vote positif 1 Vote négatif
B

BBDan

XLDnaute Nouveau
Super ! Merci beaucoup Job75. C'est vraiment génial !
Pour ce qui est de la différence, j'ai inséré une colonne "Cumul facturé", nommé la cellule dans la facture et adapté la macro à 17 colonnes au lieu des 16.
Je suis ravie de votre aide et vous remercie infiniment.
 
Vote positif 0 Vote négatif
B

BBDan

XLDnaute Nouveau
Bonjour,
J'ai voulu adapter la macro de Job75 à mon nouveau tableau, mais la macro bug.
Pourriez-vous m'aider svp ? Mon tableau ne comprend plus que 10 colonnes et la dernière colonne doit être la somme des colonnes 8 et 9.
Voici la macro :
Sub Actualiser()
Dim chemin$, fichier$, a, b(), lig&, form$, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*")
a = Array("DATE", "N°FACT", "N°SITU", "CLIENT", "CHANTIER", "LOT", "ENGT", "TTCAVTRG", "RGTTC")
ReDim b(1 To 10)
lig = 3 '1ère ligne de restitution
Application.ScreenUpdating = False
While fichier <> ""
If fichier <> ThisWorkbook.Name Then
form = "'" & chemin & "[" & fichier & "]FACTURE'!"
For i = 1 To 10
b(i) = ExecuteExcel4Macro(form & a(i - 1))
If IsError(b(i)) Then b(i) = Empty
If i > 8 Then If Not IsNumeric(b(i)) Then b(i) = Empty 'sécurité
Next
If b(8) = 0 Then b(8) = Empty
If b(8) <> b(9) Then b(10) = b(8) + b(9) 'colonne H + colonne I
If Application.CountA(b) Then
Cells(lig, 1).Resize(, 10) = b 'restitution sur 10 colonnes
lig = lig + 1
End If
End If
fichier = Dir 'fichier suivant
Wend
On Error Resume Next
Rows(lig & ":" & Rows.Count).Delete 'RAZ en dessous
Columns.AutoFit 'ajustement largeurs
End Sub
 

Pièces jointes

  • FACTURES 2021.xlsm
    20.5 KB · Affichages: 6
Vote positif 0 Vote négatif
B

BBDan

XLDnaute Nouveau
OK pas de problème. Les voici...
 

Pièces jointes

  • 12040.FP19 CH H GUERIN PIERREFEU L2 S8.xls
    169.5 KB · Affichages: 9
  • 13153.FP.21 BEC CONSTRUCTION KEDGE CDE 29859 DEVIS 14946DE21.xlsx
    79.9 KB · Affichages: 7
Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc
Le fichier en retour, les seules modifications de la macro ont porté sur :
VB: 
        For i = 1 To 9
            b(i) = ExecuteExcel4Macro(form & a(i - 1))
            If IsError(b(i)) Then b(i) = Empty
            If b(i) = 0 Then b(i) = Empty
            If i > 7 Then If Not IsNumeric(b(i)) Then b(i) = Empty 'sécurité
        Next
        b(10) = b(8) + b(9) 'colonne H + colonne I
        If b(10) = 0 Then b(10) = Empty
 

Pièces jointes

  • FACTURES 2021.xlsm
    20.9 KB · Affichages: 6
Vote positif 1 Vote négatif

job75

XLDnaute Barbatruc
Je viens de me rendre compte que Application.CountA(b) renvoie toujours 10 même quand la ligne est vide.

Il faut donc compter les cellules non vides, utilisez le fichier joint avec :
VB: 
Sub Actualiser()
Dim chemin$, fichier$, a, b(), lig&, form$, s%, i%
chemin = ThisWorkbook.Path & "\" 'dossier à adapter
fichier = Dir(chemin & "*.xls*")
a = Array("DATE", "N°FACT", "N°SITU", "CLIENT", "CHANTIER", "LOT", "ENGT", "TTCAVTRG", "RGTTC")
ReDim b(1 To 10)
lig = 3 '1ère ligne de restitution
Application.ScreenUpdating = False
While fichier <> ""
    If fichier <> ThisWorkbook.Name Then
        form = "'" & chemin & "[" & fichier & "]FACTURE'!"
        s = 0
        For i = 1 To 9
            b(i) = ExecuteExcel4Macro(form & a(i - 1))
            If IsError(b(i)) Then b(i) = Empty
            If b(i) = 0 Then b(i) = Empty
            If i > 7 Then If Not IsNumeric(b(i)) Then b(i) = Empty 'sécurité
            If Not IsEmpty(b(i)) Then s = s + 1 'compte les valeurs non vides
        Next
        b(10) = b(8) + b(9) 'colonne H + colonne I
        If b(10) = 0 Then b(10) = Empty
        If s Then
            Cells(lig, 1).Resize(, 10) = b 'restitution sur 10 colonnes
            lig = lig + 1
        End If
    End If
    fichier = Dir 'fichier suivant
Wend
On Error Resume Next
Rows(lig & ":" & Rows.Count).Delete 'RAZ en dessous
Columns.AutoFit 'ajustement largeurs
End Sub
 

Pièces jointes

  • FACTURES 2021(1).xlsm
    21.2 KB · Affichages: 3
Vote positif 0 Vote négatif
B

BBDan

XLDnaute Nouveau
Bonsoir,
Je rencontre un bug avec la facture ci-jointe. Pourriez-vous me dire pourquoi svp ?
Quand je l'enlève du dossier, tout refonctionne normalement.
Merci d'avance de votre aide.
 

Pièces jointes

  • 13124.FP.21 SCI L'ENFANT EUROFINS S2.xlsx
    279.4 KB · Affichages: 3
  • 0. FACTURES 2021.xlsm
    24.8 KB · Affichages: 2
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

C
  • Question
XL 2021 Excel facturation avec BD clients (modèle utilisable joint) - liste déroulante =INDIRECT sur classeur séparé
Réponses
12
Affichages
802
Calizarine
C
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
695
Pac41240
P
  • Question
XL 2019 Importer des classeurs à la suite dans un tableau existant
2
Réponses
15
Affichages
1 K
Hasco
  • Résolu(e)
Microsoft 365 Ajout d'onglet par VBA et entête de colonnes
2
Réponses
17
Affichages
923
Roseline
M
  • Résolu(e)
XL 2013 VBA enregistrement fichier dans un dossier en particulier
Réponses
3
Affichages
320
MarineU
M
A
  • Résolu(e)
XL 2021 Macro de création mail de relance avec référence cellules
Réponses
4
Affichages
579
arnoldbrice19
A
A
  • Question
XL 2021 Macro copier dans un fichier Excel sur Sharepoint
Réponses
1
Affichages
228
vgendron
R
  • Question
XL 2021 Récupérer des données dans plusieurs classeurs sans les ouvrir - Résolu
Réponses
10
Affichages
479
job75
V
  • Question
XL 2021 Implémenter tableau avec des fichiers mis dans un dossier
Réponses
2
Affichages
331
merinos-BernardEtang
M
  • Résolu(e)
XL 2013 Macross supprimant les données de cellule en dehors d'une période définie dans deux autres cellules
Réponses
9
Affichages
544
MarineU
M
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…