Petite modif sur Macro existante

Salut,

Il y a quelques années maintenant, une âme charitable de ce forum m'avait fait cette petite macro, qui vient récupérer quelques données dans tous les fichiers excel du dossier (et sous-dossiers) qui se termine par "DS-516" pour les coller dans l'odre dans un tableau.

La Macro:

Dim nr

Sub recap_valeurs()
    nr = 1
    browsefolder ("W:\INSTRUCTION\EB - Instructions de controle réception\EB_Relevé de contrôle\Relevés de Contrôle Signés (originaux)\DS - Insert\- Suivi\DS-5xx_Inserts OMNIDENT")
MsgBox "importation OK"
End Sub
Sub browsefolder(Optional chemin = "")
    Set cws = ThisWorkbook.ActiveSheet
    If chemin = "" Then chemin = ThisWorkbook.Path
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set folder = FSO.GetFolder(chemin)
    For Each fich In folder.Files
          If InStr(UCase(fich), "DS-516.XLS") Then
          nr = nr + 1
        cws.Cells(nr, 1) = fich 'inscrit le nom de fichier en ligne 2/colonne 1
        cws.Cells(nr, 2) = FSO.GetFile(fich).DateCreated 'inscrit la date de création du fichier en ligne 2/colonne 2

            Set nwb = Workbooks.Open(fich, ReadOnly:=True)
            'prend la valeur se situant à 8 cellules de la cellule contenant le mot "Moyenne"
            Set re = nwb.Worksheets(1).Cells.Find("Moyenne", lookat:=xlWhole)
            If Not re Is Nothing Then cws.Cells(nr, 3) = re.Offset(0, 8)
            'prend la valeur se situant à 10 cellules de la cellule contenant le mot "Moyenne"
            Set re3 = nwb.Worksheets(1).Cells.Find("Moyenne", lookat:=xlWhole)
            If Not re3 Is Nothing Then cws.Cells(nr, 4) = re3.Offset(0, 10)
            'prend la valeur se situant à 11 cellules de la cellule contenant le mot "Moyenne"
            Set re3 = nwb.Worksheets(1).Cells.Find("Moyenne", lookat:=xlWhole)
            If Not re3 Is Nothing Then cws.Cells(nr, 5) = re3.Offset(0, 11)
            nwb.Close
        End If
    Next
    For Each Rep In folder.SubFolders
        browsefolder Rep
    Next
End Sub

Le tableau récap:

Le truc, c'est qu'aujourd'hui j'ai une certaine quantité de fichiers excel…. et la macro repart du début à chaque fois, donc ca devient assez long.

Je me demandais donc s'il y avait pas un moyen pour faire en sorte que ca reprenne les données uniquement des fichiers excel qui ne sont pas déjà importés, pour les incrémentés dans les lignes suivantes.

Ou, si pas possible, je sais pas, peut-être pouvoir saisir quelque part une date de départ ?

Merci d'avance.

Bonjour,

Peut-être en rajoutant une condition :

....
If InStr(UCase(fich), "DS-516.XLS") And IsError(Application.Match(fich, cws.Columns(1), 0)) Then
....

Application.Match est l'équivalent "Formule" de "EQUIV"

Peut-être?

PS, je ne comprends pas pourquoi tu fais 3 recherches de "MOYENNE"...

....
            Set re = nwb.Worksheets(1).Cells.Find("Moyenne", lookat:=xlWhole)
            If Not re Is Nothing Then
                cws.Cells(nr, 3) = re.Offset(0, 8)
                cws.Cells(nr, 4) = re.Offset(0, 10)
                cws.Cells(nr, 5) = re.Offset(0, 11)
            End If
            ....

Suffirait peut-être?

Merci pour cette proposition.

Alors pour le rajout de la condition, ca prend maintenant en effet simplement en compte les nouveaux fichiers dans le dossier, par contre ca semble remplacer les fichiers existants dans les lignes, ca ne les ajoute pas à la suite:

le fichier "BC-20-3532-02" aurait dû s'incrémenter après le "BC-18-3532-01".

Pour les 3 recherches de moyenne en effet ca semble assez logique, mais étant incapable de programmer le VBA j'ai pris ce qu'on m'a donné

J'ai essayé et ca marche pareil oui, merci

Bonjour,

Remplace la ligne nr = nr +1 par cette ligne, pour calculer la première ligne vide :

nr = cws.Cells(Rows.Count, "A").End(xlUp).Row + 1 'calcul de la première ligne vide

Peut-être?

Mais on dirait que c'est parfait tout ca !

Ca fonctionne bien, je vais gagner un peu de temps, un grand merci à toi !