fiche et case

Le
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
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
docm
Le #1327160
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" 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


Publicité
Poster une réponse
Anonyme