Sub tt()
    Cells(2, 1).Resize(Cells(Rows.Count, 1).End(3).Row).ClearContents
    r0_ = 6
    For Each sh In ThisWorkbook.Sheets
        With sh
            If .Name <> Me.Name Then
                r1_ = .Cells(.Rows.Count, 5).End(3).Row
                If r1_ >= r0_ Then
                    n_ = n_ + r1_ - r0_ + 1
                End If
            End If
        End With
    Next sh
    'можно без блока выше, переназначать массив каждый раз redim preserve, но это фу
    'правда с блоком тоже фу :)
    ar = Cells(2, 1).Resize(n_)
    For Each sh In ThisWorkbook.Sheets
        With sh
            If .Name <> Me.Name Then
                k_ = .Cells(.Rows.Count, 5).End(3).Row - r0_ + 1
                If k_ > 0 Then
                    ari = .Cells(r0_, 5).Resize(k_)
                    For i = 1 To k_
                        x_ = x_ + 1
                        ar(x_, 1) = ari(i, 1)
                    Next i
                End If
            End If
        End With
    Next sh
    Cells(2, 1).Resize(n_) = ar
End Sub

Sub ee()
    Cells(2, 1).Resize(Cells(Rows.Count, 1).End(3).Row).ClearContents
    Set slov = CreateObject("Scripting.Dictionary")
    r0_ = 6
    For Each sh In ThisWorkbook.Sheets
        With sh
            If .Name <> Me.Name Then
                k_ = .Cells(.Rows.Count, 5).End(3).Row - r0_ + 1
                If k_ > 0 Then
                    ari = .Cells(r0_, 5).Resize(k_)
                    For i = 1 To k_
                        x_ = x_ + 1
                        slov.Item(x_) = ari(i, 1)
                    Next i
                End If
            End If
        End With
    Next sh
    Cells(2, 1).Resize(x_) = Application.Transpose(slov.Items)
End Sub