macro vérification existence plusieurs fichiers suivant valeur dans colonne A

[vmax67]

Bonjour à tous

je cherche à modifier ma macro afin de tester l'existence de plusieurs fichiers suivant valeur dans colonnes A.

Le nom des fichiers se trouvent en colonnes A1 à A40.
Est le nom du répertoire de recherche des fichiers se trouve en F1.

Ci-dessous le code.

Sub Existence()
Dim O As Worksheet 'déclare la variable O (Onglet)
Dim TC As Variant 'déclare la variable TC (Tableau de Cellules)
Dim I As Integer 'déclare la variable I (Incrément de ligne)
Dim REP As String 'déclare la variable REP (REPertoire)
Dim Fichier As String 'déclare la variable Fichier

Set O = Sheets("Testnom") 'définit l'onglet O
TC = O.Range("A1").CurrentRegion 'définit le tableau de cellules TC (à adapter si il existe des lignes ou colonnes vides)
For I = 2 To UBound(TC, 1) 'boucle 1 : sur toutes les lignes I du tableau de cellules TC
REP = TC(I, 11) 'définit le répertoire REP par rapport à la cellule ligne I colonne K
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
ChDir REP 'change le répertoire courant (génère une erreur si le repertoire n'existe pas)
If Err <> 0 Then 'condition : si une erreur a été générée
Err = 0 'annule l'erreur
O.Cells(I, 12).Value = "Dossier inexistant!" 'renvoie ce texte dans la cellule Ligne I colonne 12 (=L)
GoTo Suite 'va à l'étiquette "Suite"
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Fichier = Dir(REP & "\*.pdf") 'définit la variable Fichier
If Fichier = "" Then 'condition : si fichier est vide
O.Cells(I, 12).Value = "Aucun fichier PDF dans ce dossier !" 'renvoie ce texte dans la cellule Ligne I colonne 12 (=L)
Else 'sinon
O.Cells(I, 12).Value = "Le fichier PDF est dans ce dossier" 'renvoie ce texte dans la cellule Ligne I colonne 12 (=L)
End If 'fin de la condition
Suite: 'étiquette
Next I 'prochaine ligne de la boucle
End Sub



Merci

Vmax