Sub tableau()
Dim table As ListObject
Dim NomTable As String
Dim ws As Worksheet
Dim dest As Range
Sheets("CONSO").Range("A1:Z65000").ClearContents
With ThisWorkbook.Sheets("CONSO")
.Range("A1").Clear
.Range("A1:B1") = Array("Ville", "Données")
End With
For Each ws In ThisWorkbook.Worksheets()
If ws.Name <> "CONSO" And ws.Name <> "Menu" Then
Set dest = ThisWorkbook.Sheets("CONSO").Cells(Rows.Count, 1).End(xlUp)(2)
With ws.Range("A1").CurrentRegion
dest.Resize(.Rows.Count - 1, .Columns.Count).Value = .Offset(1).Resize(.Rows.Count - 1).Value
End With
End If
Next
With ThisWorkbook.Sheets("CONSO")
'On Error Resume Next
.ListObjects.Add(xlSrcRange, .Range("A1:B" & Sheets("CONSO").Range("A65500").End(xlUp).Row), , xlYes).Name = NomTable
End With
End Sub