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.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
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
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" <grevin@sabate.fr> wrote in message
news:ea12f5fd.0404280745.4a6aaf7b@posting.google.com...
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.
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.