1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43
| Sub Recherche()
Dim DerLig As Long 'Dernière ligne renseignée de la feuille "Clicks"
Dim DerCol As Integer 'Dernière colonne renseignée de la feuille cible (feuille "Synthese")
Dim WsCible As Worksheet 'La feuille cible est celle ou sont collées les données (feuille "Synthese")
Dim WsSource As Worksheet 'La feuille source est celle ou sont copiées les données (feuille "Foglio1")
Dim MaPlage As Range, Cel As Range
Set WsCible = Worksheets("Synthese")
With Worksheets("Clicks")
'Recherche de la dernière ligne renseignée dans colonne A
DerLig = .Range("A" & .Rows.Count).End(xlUp).Row
'Definition Plage de A1 à A" & Derlig
Set MaPlage = .Range("A1:A" & DerLig)
'On passe sur chaque cellule de la colonne A afin d'avoir le nom de la feuille à examiner
For Each Cel In MaPlage
i = 0
'Tant que la cellule à droite du nom de feuille n'est pas vide
While Cel.Offset(0, i + 1) <> ""
i = i + 1
'On déclare la feuille à examiner
Set WsSource = Worksheets(Cel.Value)
'On recherche la cellule correspondant au partner associé
Set valeur = WsSource.Rows(2).Find(What:=Cel.Offset(0, i), After:=WsSource.Cells(2, WsSource.Columns.Count), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If Not valeur Is Nothing Then
firstAddress = valeur.Address
Do
'On recherche la dernière colonne renseignée de la feuille cible
DerCol = WsCible.Cells(1, WsCible.Columns.Count).End(xlToLeft).Column
If WsCible.Range("A1") = "" And DerCol = 1 Then DerCol = 0
'On copie les 10 cellules en dessous de la cellule trouvée et on les colle dans la feuille cible
valeur.Offset(1, 0).Resize(10, 1).Copy Destination:=WsCible.Cells(1, DerCol + 1)
Set valeur = WsSource.Rows(2).FindNext(valeur)
Loop While Not valeur Is Nothing And valeur.Address <> firstAddress
End If
Set WsSource = Nothing
Set valeur = Nothing
Wend
Next Cel
End With
WsCible.Activate
Set MaPlage = Nothing
Set WsCible = Nothing
End Sub |
Partager