Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

fiche et case

1 réponse
Avatar
grevin
Bonjour,

Je cherche à ecrire une macro qui
- ouvre tous les fichiers d'un repertoire,
- compare la donnée d'une case précise (toujours la même) à une
référence et,
- selon la valeur lue, copie une valeur qui est dans une autre case
sur une feuille dite de synthèse.

Il me semble avoir lu qqc comme cela sur le forum il y a qq mois mais
impossible de le retrouver.

Merci de votre aide.


Jérôme

1 réponse

Avatar
docm
Bonjour Jérôme.

Je crois que ça peut se faire comme ceci (sous toutes réserves cependant):

Sub ChercherLaMemeValeur()
Dim DossierDeBase As Workbook
Dim mondossier As Workbook
Dim CelluleSource1 As Range
Dim CelluleSource2 As Range
Dim CelluleDestination As Range
Dim NumeroDeLigne As Long
Dim i As Long

Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "C:mes documents"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
Set DossierDeBase = ThisWorkbook
NumeroDeLigne = 1
For i = 1 To .FoundFiles.Count
Set mondossier = Workbooks.Open(.FoundFiles(i))
Debug.Print mondossier.FullName
Set CelluleSource1 = mondossier.Worksheets(1).Range("a1")
Set CelluleSource2 = mondossier.Worksheets(1).Range("B1")

If CelluleSource1.Value = ValeurReference Then

Set CelluleDestination DossierDeBase.Worksheets(1).Cells(NumeroDeLigne, 1)

CelluleDestination.Value = CelluleSource2.Value

NumeroDeLigne = NumeroDeLigne + 1

End If

mondossier.Close

Next i
End If
End With
Application.ScreenUpdating = True
End Sub

Amicalement,
Gérard

"g-rom" wrote in message
news:
Bonjour,

Je cherche à ecrire une macro qui
- ouvre tous les fichiers d'un repertoire,
- compare la donnée d'une case précise (toujours la même) à une
référence et,
- selon la valeur lue, copie une valeur qui est dans une autre case
sur une feuille dite de synthèse.

Il me semble avoir lu qqc comme cela sur le forum il y a qq mois mais
impossible de le retrouver.

Merci de votre aide.


Jérôme