Запись столбца в строчку

i=1
do until cells(i,1)=''
text1.text=cells (i,1)+ chr(44)+text1.text
loop

' если данные на всем диапазоне и имеются пустые клетки
' виснет, а ты как хотел 65536 это много
For i = 1 To 65536
If Cells(i, 1) <> '' Then Cells(1, 2) = Cells(1, 2) & Cells(i, 1) & ','
Next i
 
'нет пробелов то
 
Do Until Cells(i, 1) = ''
Cells(1, 2) = Cells(1, 2) & Cells(i, 1) & ', '
i = i + 1
Next i

Function Строка(myR As Range) As String
If myR Is Nothing Then Exit Function
Dim myD As DataObject
    Set myD = New DataObject
    myR.Copy
    myD.GetFromClipboard
    Строка = Replace(myD.GetText, vbCrLf, ',')
    Set myD = Nothing
End Function

Function Строка(myR As Range) As String
If myR Is Nothing Then Exit Function
Dim myD As DataObject
    Set myD = New DataObject
    myR.Copy
    myD.GetFromClipboard
    Строка = Replace(myD.GetText, vbCrLf, ',')
    Set myD = Nothing
End Function
 
Sub НужнаяСтрока()
Dim mySTR As String
Application.ScreenUpdating = False
    Columns(1).AutoFilter Field:=1, Criteria1:='<>'
    mySTR = Строка(Columns(1).Cells.SpecialCells(xlCellTypeVisible))
    Columns(1).AutoFilter
Application.ScreenUpdating = True
MsgBox Len(mySTR)
End Sub

Columns(1).AutoFilter Field:=1, Criteria1:='<>'