Combiner plusieurs plages de données pour faire une liste

Sub ConstruitTableau()
Range("K3:K1000").ClearContents ' Efface tableau de sortie
Lwrite = 3                      ' Première ligne d'écriture
ColK = 11                       ' N° colonne tableau de sortie
tablo = Range("B3:H9")          ' Transfert de tout le tableau dans une table
For j = 1 To UBound(tablo)      ' Pour toutes les colonnes du tableau
    For i = 1 To UBound(tablo, 2) ' Pour toutes les lignes du tableau
        If tablo(i, j) <> "" And Left(tablo(i, j), 4) <> "Test" Then    ' Si non vide et si ne contient pas Test
            Cells(Lwrite, ColK) = tablo(i, j)                           ' On tarnfert dans le tableau de sortie
            Lwrite = Lwrite + 1                                         ' On incrémente l'indice d'écriture
        End If
    Next i
Next j
End Sub

Option Explicit

Dim lg2&

Private Sub Job(Tbl$)
  With Worksheets("Test").ListObjects(Tbl)
    .DataBodyRange.Copy Cells(lg2, 11): lg2 = lg2 + .ListRows.Count
  End With
End Sub

Sub Essai()
  lg2 = 3: Application.ScreenUpdating = 0
  Worksheets("Test").ListObjects("Tableau5").DataBodyRange.ClearContents
  Job "Tableau2": Job "Tableau3": Job "Tableau4"
End Sub

  With Worksheets("Test").ListObjects(Tbl)
    .DataBodyRange.Copy [Tableau5].Cells(lg2, 1): lg2 = lg2 + .ListRows.Count
  End With
End Sub

Option Explicit

Dim lg2&

Private Sub Job(Tbl$)
  With Worksheets("Test").ListObjects(Tbl)
    .DataBodyRange.Copy [Tableau5].Cells(lg2, 1): lg2 = lg2 + .ListRows.Count
  End With
End Sub

Sub Essai()
  lg2 = 1: Application.ScreenUpdating = 0
  Worksheets("Test").ListObjects("Tableau5").DataBodyRange.ClearContents
  Job "Tableau2": Job "Tableau3": Job "Tableau4"
End Sub

' trier par ordre alphabétique  
     ' sélectionner Total
    Application.Goto Reference:="Total"
    ActiveWorkbook.Worksheets("Décompte_heures").ListObjects("Total").Sort. _
        SortFields.Clear
    ActiveWorkbook.Worksheets("Décompte_heures").ListObjects("Total").Sort. _
        SortFields.Add2 Key:=Range("B17:B27"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Décompte_heures").ListObjects("Total").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

 SortFields.Add2 Key:=Range("B17:B27"), SortOn:=xlSortOnValues, Order:= _