Petit ajout sur mon script

Hello,

J'ai fait un script qui compare 2 onglets d'un fichier et je fais une comparaison entre les 2 listes de noms de fichiers pour colorer en vert la cellule quand le fichier est présent et en rouge quand il est manquant.

Mon soucis est que j'aimerais adapter ce code afin qu'il me conserve les données d'une journée sur l'autre (Et idéalement pouvoir le lancer selon la date).

Voici mon code :

Sub DeliveryOrNot()

Sheets("report analysis").Select

For iR = 4 To Sheets("report analysis").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("report analysis").Range("B" & iR).Select
    For iF1 = 1 To Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Row
        'If Sheets("report analysis").Range("A" & iR) Like Sheets("Feuil1").Range("A" & iF1) Then
        If InStr(Sheets("Feuil1").Range("A" & iF1).Text, Sheets("report analysis").Range("A" & iR).Text) <> 0 Then
            With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 5287936
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
            End With
            Exit For
        Else
            With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .Color = 255
                        .TintAndShade = 0
                        .PatternTintAndShade = 0

            End With
       End If

    Next iF1
Next iR

End Sub

Pour la feuille 1 les données sont récupérées dans un dossier réseau grâce à ce code :

Sub listefichier()
Dim Dossier As Object, Fichier As Object
Dim Chemin As String
Dim I As Long

Sheets("Feuil1").Activate
Columns("A:A").Select
Selection.ClearContents

'Chemin du dossier à analyser
Chemin = "G:\poulp\titi\test" & Format(Date - 1, "yyyy-mm-dd") & "\"

'Définition de la variable
Set Dossier = CreateObject("Scripting.FileSystemObject").GetFolder(Chemin)

' Boucle sur les fichiers
For Each Fichier In Dossier.Files
    I = I + 1
    Cells(I, 1) = Left(Fichier.Name, InStr(Fichier.Name, ".") - 1) ' Nom du fichier sans extension

Next

End Sub

Merci pour vos retours.

9test.xlsm (16.68 Ko)
Rechercher des sujets similaires à "petit ajout mon script"