Append multiple table into one excel table

With the macro integratie_Oeldere_revisted_vs3

See the result in the sheet consolidated in the attached file.

Sub integratie_Oeldere_revisted_vs3()

'I got a lot of help from AB33, to get this code working; thanks for that AB33.

Dim wsTest As Worksheet

'check if sheet "Consolidated" already exist

Const strSheetName As String = "Consolidated"
 
Set wsTest = Nothing
On Error Resume Next
Set wsTest = ActiveWorkbook.Worksheets(strSheetName)
On Error GoTo 0
 
If wsTest Is Nothing Then
    Worksheets.Add.Name = strSheetName
End If

With Sheets("Consolidated")
    .UsedRange.ClearContents
    .Range("A1:D1").Value = Array("sheet", "Date", "Address", "Price")
    For Each Sh In Sheets
        With Sh
            If .Name <> "Consolidated" And .Name <> "Agents" And .Name <> "RECAP" And .Name <> "PivotTable" Then
                 lr = .Cells(.Rows.Count, 1).End(xlUp).Row
                If lr >= 4 Then
                   Rng = .Cells.Find("*", , , , xlByRows, xlPrevious).Row - 1
                   NR = Sheets("Consolidated").Cells.Find("*", , , , xlByRows, xlPrevious).Row + 1
                   If Rng > 0 Then
'                    Sheets("Consolidated").Cells(NR, 1).Resize(Rng) = .Name
                    Sheets("Consolidated").Cells(NR, 1).Resize(Rng, 4) = .Range("A2").Resize(Rng, 4).Value
                  End If
               End If
            End If
        End With
    Next
    On Error Resume Next
    .Range("C2:C" & .Rows.Count).SpecialCells(4).EntireRow.Delete

    For Each cl In .Range("C2:C" & .Rows.Count)
    If cl = "Address" Then
    cl.Rows.EntireRow.Delete
    End If
    Next

    Call Sort_columnB
    .Columns("A:Z").EntireColumn.AutoFit
End With
End Sub


Sub Sort_columnB()

    ActiveWorkbook.Worksheets("Consolidated").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Consolidated").Sort.SortFields.Add Key:=Range( _
        "B2:B5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Consolidated").Sort
        .SetRange Range("A1:D5")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub