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

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.

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 :rolleyes:

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:

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

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:

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.
 

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

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

BBDan

XLDnaute Nouveau
Malheureusement, j'ai un message d'erreur lorsque je clique sur le bouton actualiser...
Je ne comprends pas d'où ça vient.
1614188058863.png
 

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

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

Discussions similaires

Statistiques des forums

Discussions
311 735
Messages
2 082 023
Membres
101 873
dernier inscrit
excellllll