Option Explicit
Private Sub Workbook_Open()
Rechercher
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next: Unload UserForm1: On Error GoTo 0
If Not Sh.Name Like "*_Dispatch*" Then Exit Sub
Rechercher
End Sub
Sub Rechercher()
Dim Sh, T, n&, i&, j&
Dim Faux As Worksheet, auxOK As Boolean
Application.ScreenUpdating = False
Application.DisplayAlerts = False: On Error Resume Next
Sheets("aux").Delete: Application.DisplayAlerts = True
ThisWorkbook.Worksheets.Add: ActiveSheet.Name = "aux"
auxOK = True
On Error GoTo Err001
For Each Sh In Worksheets
With Sh
If .Name Like "*_Dispatch" Then
T = .Range("a1").CurrentRegion
For i = 2 To UBound(T)
For j = 2 To UBound(T, 2)
If Trim(T(i, j)) <> "" Then
n = n + 1
With Sheets("aux")
.Cells(n, 1) = T(i, j)
.Cells(n, 2) = Sh.Name
.Cells(n, 3) = Cells(i, j).Address(0, 0, xlA1)
.Cells(n, 4) = T(i, 1) & " / " & T(1, j)
End With
End If
Next j
Next i
End If
End With
Next Sh
If n > 1 Then
With Sheets("aux").Range("a1").CurrentRegion
.Sort .Range("a1"), xlAscending, Header:=xlNo
.Columns(1).Offset(, 4).Formula = "=if(COUNTIF(" & .Address & ",A1)=1,1)"
For i = .Rows.Count To 1 Step -1
If .Cells(i, 5) = 1 Then .Rows(i).Delete xlShiftUp
Next i
.Columns(1).Offset(, 4).EntireColumn.Clear
End With
With UserForm1
.ListBox1.List = Sheets("aux").Range("a1").CurrentRegion.Value
.Show vbModeless
End With
End If
If auxOK Then
Application.DisplayAlerts = False
Sheets("aux").Delete: Application.DisplayAlerts = True
End If
Exit Sub
Err001:
If auxOK Then
Application.DisplayAlerts = False
Sheets("aux").Delete: Application.DisplayAlerts = True
End If
End Sub