Private Sub Worksheet_Change(ByVal Target As Range)
Dim sh As Worksheet
Dim c As Range
Dim l As Long
If Target.Column <> 1 Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
If Not Intersect(Range("A3"), Target) Is Nothing Then
Application.EnableEvents = False
Application.ScreenUpdating = False
Range("B:E").Clear
l = Target.Row
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> ActiveSheet.Name Then
Set c = sh.Cells.Find(Target, , xlValues, xlPart)
If Not c Is Nothing Then
ActiveSheet.Cells(l, 2) = sh.Name
l = l + 1
adrdeb = c.Address
Do
With sh
col = .Range("V" & c.Row).End(xlToLeft).Column
.Range(.Cells(c.Row, 1), .Cells(c.Row, col)).Copy
ActiveSheet.Range("B" & l).PasteSpecial Paste:=xlPasteValues
End With
l = l + 1
Set c = sh.Cells.FindNext(c)
Loop While Not c Is Nothing And c.Address <> adrdeb
End If
End If
l = l + 1
Next sh
Application.CutCopyMode = False
Application.ScreenUpdating = True
Application.EnableEvents = True
Range("A3").Select
End If
End Sub