Копировать фамилии в листы, имя которых бы совпадало с первой буквой фамилии

Sub Test()
    Dim i As Long, j As Long, s As String
    Dim src As Worksheet, dst As Worksheet
    On Error Resume Next
    
    ' Создаем листы на все буквы (если такие листы есть, то не создаем их)
    For i = Asc("А") To Asc("Я")
        Set dst = Worksheets(Chr(i))
        If dst Is Nothing Then
            Set dst = Worksheets.Add(, Worksheets(Worksheets.Count))
            dst.Name = Chr(i)
        End If
        Set dst = Nothing
    Next
    
    Set src = Worksheets(1)
    
    i = 2 ' Перебор сводного листа, пока не кончится список
    Do While src.Cells(i, 1).Value <> ""
        ' Получить первую букву фамилии
        s = Left(src.Cells(i, 1).Value, 1)
        ' Выбрать соответствующий лист
        Set dst = Worksheets(s)
        j = 2 ' Найти на соответствующем листе первую свободную ячейку
        Do While dst.Cells(j, 1).Value <> ""
            j = j + 1
        Loop
        ' Вставить фамилию на соответствующий лист
        dst.Cells(j, 1).Value = src.Cells(i, 1).Value
        ' Освободить объект
        Set dst = Nothing
        ' К следующей строке списка фамилий
        i = i + 1
    Loop
    
    Set src = Nothing
End Sub