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
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 725
Messages
2 081 949
Membres
101 851
dernier inscrit
vaiata