Option Explicit
Option Base 1
Option Compare Text
Sub Recherche()
'Déclaration des variables
Dim i As Long, h As Long, Lig, NoLigne, Valeur As Integer
Dim maPlage As Range, Cel As Range, C As Range, Cel1 As Range, maPlage1 As Range
Dim ValChercher, Chemin As String
Dim Ws As Worksheet, Ws1 As Worksheet
Dim CLASSEUR As String
Dim Flag1 As Boolean
'Indiquer l'emplacement complet du fichier (chemin + nom + ext)
'CLASSEUR = "V:\Production\Partagé\PRODUCTION\productivité\cuisine\Copie de Productivité Montage 2014.xls"
CLASSEUR = "C:\Users\david-v\Desktop\Layout\Source.xlsm"
For i = 1 To Application.Windows.Count
If Workbooks(i).FullName = CLASSEUR Then
Flag1 = True
Workbooks(i).Activate
End If
Next i
If Flag1 = False Then Workbooks.Open (CLASSEUR)
Set Ws = ThisWorkbook.Sheets("RECAP")
'Le libellé à chercher dans les autres feuilles (Dans l'exemple présent en [A5] de la feuille "RECAP"
Set maPlage1 = Ws.Range("A5:A" & Ws.Range("A65536").End(xlUp).Row)
Set maPlage = Ws.Range("C4:H4")
'Plage de cellule où se trouve les mois (Doivent correspondrent au nom des feuilles)
For Each Cel1 In maPlage1
ValChercher = Cel1.Value
For Each Cel In maPlage
'Si aucune feuille ne porte le nom du mois, on passe à la suivante
'
On Error Resume Next
'Avec la feuille ayant pour nom le mois correspondant
For i = 1 To ActiveWorkbook.Sheets.Count
If ActiveWorkbook.Sheets(i).Name Like "*" & Cel.Value & "*" And Cel.Value <> "" Then Set Ws1 = ActiveWorkbook.Sheets(i)
Next i
If Not Ws1 Is Nothing Then
With Ws1
'On cherche le libellé ValChercher dans la feuille
Set C = .Cells.Find(ValChercher, , xlValues, xlWhole)
'On vérifie qu'il y'ai une correspondance
If Not C Is Nothing Then
Ws.Cells(Cel1.Row, Cel.Column).Value = .Cells(.Cells(65536, C.Column).End(xlUp).Row, C.Column).Value
Else
MsgBox "Le libellé: " & ValChercher & " n'a pas été trouvé dans la feuille " & .Name, vbCritical, "Attention"
End If
Set C = Nothing
End With
Else
MsgBox "La feuille correspondant à " & Cel.Value & " n'a pas été trouvée", vbCritical, "Attention"
End If
Set Ws1 = Nothing
Next Cel
Next Cel1
Ws.Activate
End Sub