Option Explicit

Public Sub getSpisok()
    Dim oDict, arrKey
    Dim i As Integer, j%, rowLast%
    Const outList As String = "СВОД"
    
    Set oDict = CreateObject("Scripting.Dictionary")
    oDict.CompareMode = 1
    For i = 1 To Worksheets.Count
        If Worksheets(i).Name <> outList Then
            With Worksheets(i)
                rowLast = .Cells(Rows.Count, 1).End(xlUp).Row
                For j = 1 To rowLast
                    If .Cells(j, 1).Value <> "" Then
                        If Not oDict.exists(.Cells(j, 1).Value) Then
                            oDict(.Cells(j, 1).Value) = 1
                        Else
                            oDict(.Cells(j, 1).Value) = oDict(.Cells(j, 1).Value) + 1 'количество повторов
                        End If
                    End If
                Next j
            End With
        End If
    Next i
    arrKey = oDict.keys
    With Worksheets(outList)
        .Cells(1, 1).Select
        .Cells.Clear
        .Cells(1, 1).Resize(oDict.Count) = Application.Transpose(oDict.keys)
        .Cells(1, 2).Resize(oDict.Count) = Application.Transpose(oDict.items)
        
        .UsedRange.Select
        Call setFormat
        .Cells(1, 1).Select
    End With
End Sub

Private Sub setFormat()
'
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Font
        .Name = "Times New Roman"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Columns("A:A").ColumnWidth = 80
End Sub