Private Sub Worksheet_Change(ByVal Target As Range)
Dim resu(), n As Byte, tablo, titre$, i&, x$, j&
ReDim resu(1 To Rows.Count, 1 To 2)
For n = 1 To 3
tablo = ListObjects(n).Range 'matrice, plus rapide
titre = tablo(1, 1)
For i = 2 To UBound(tablo)
x = Trim(tablo(i, 1))
If x <> "" Then j = j + 1: resu(j, 1) = titre: resu(j, 2) = x
Next i, n
'---restitution---
Application.EnableEvents = False 'désactive les évènements
With ListObjects(4).Range
If j Then .Cells(2, 1).Resize(j, 2) = resu Else .Rows(2).ClearContents
On Error Resume Next
.Rows(j + 2).Resize(.Rows.Count - j - 1).Delete xlUp 'RAZ en dessous...