For Each Tcell In wb.Worksheets(1).Columns(3).SpecialCells(xlVisible)

Sub Filling()
Dim arrKP() As Variant
Dim Rcnt As Range
For Each Rcnt In Worksheets("TKP").Columns(2).SpecialCells(xlVisible)
    arrKP(Rcnt.Row - 1) = Rcnt.Value
Next
End Sub

Me.Tag_List.List = Application.Transpose(Worksheets("TKP").Range("B2", "B" & (Cells(Rows.Count, 1).End(xlUp).Row)))

Me.Tag_List.List = Worksheets("TKP").Columns(2).SpecialCells(xlVisible).Value

Sub save(bn As String) 'bn имя и путь моего csv файла
Dim r As Range, c As Range, s As String
Open bn For Output As #1
For Each r In ActiveSheet.UsedRange.Rows
   s = ""
   For Each c In r.Cells
       s = s & ";" & """" & c & """"
   Next
   Print #1, Mid$(s, 2)
Next
Close #1
End Sub

Public oWb As Workbook
Public newWb As Workbook
Public TUrng As Integer
Public avFiles
Sub Main()
    
Dim FSName
Set oWb = Application.Workbooks.Open(avFiles)
Set newWb = Workbooks.Add
<<<<<< Запись данных в таблицу newWb >>>>>>
filename$ = ActiveWorkbook.Path & "MyFile.csv"
                            'newWb.SaveAs filename:="MyFile.csv", FileFormat:=xlCSV, CreateBackup:=False, local:=True
newWb.Close False
oWb.Close False

If SaveTextToFile(txt$, filename$) = True Then
MsgBox "UTF-8"
Else
MsgBox "Windows-1251"
End If

'--------------------------------------------------------------------------------------------------------------------------------------
Function SaveTextToFile(ByVal txt$, ByVal filename$) As Boolean
    On Error Resume Next: Err.Clear

            With CreateObject("ADODB.Stream")
                .Type = 2: .Charset = "utf-8": .Open
                .WriteText txt$
                .SaveToFile filename$, 2
                .Close
            End With
 
    SaveTextToFile = Err = 0: DoEvents
End Function

FSName = Application.GetSaveAsFilename

newWb.SaveAs FileFormat:=xlCSVMSDOS, CreateBackup:=False, local:=True
newWb.Close false
oWb.Close False

FSName = Application.GetSaveAsFilename

newWb.SaveAs Filename:=FSName, FileFormat:=xlCSV, CreateBackup:=False
newWb.Close True

"1,2,3,4","1,2,3,4","1,2,3,4"  'сохраняет CSV с разделителем запятая, вместо точки с запятой и появились кавычки, если отрывать в Notepad++

1,2,3,4;1,2,3,4;1,2,3,4        'должно быть так

Public oWb As Workbook
Public newWb As Workbook
Public WsCnt As Integer
Public iColF As Integer
Public TUrng As Integer
Option Base 1


Sub Main()
    
Dim i As Integer, j As Integer, k As Integer, iColNum As Integer, iHollow As Integer    'счетчики

Dim FSName

Set newWb = Workbooks.Add                                       'создание новой Книги
Application.WindowState = xlMinimized

<<<< Парсим данные из oWb в newWB >>>>

Application.Visible = True
Application.StatusBar = True

    FSName = Application.GetSaveAsFilename(fileFilter:="Text Files (*.csv), *.csv")

    ActiveWorkbook.SaveAs Filename:=FSName, FileFormat:=xlCSV, CreateBackup:=False   '<<<---------на этом этапе после выбора имени и расположения файла
                                                                                                  имя присваивается не файлу newWb, а Файлу скрипа        

newWb.Close True
oWb.Close False
Application.Visible = False
Application.StatusBar = False
UserForm1.Show
------------------------------------------------------------UserForm1-----------------------------------------------------------------------
Sub Command_Open_Click()
Dim avFiles

    avFiles = Application.GetOpenFilename _
                ("Excel files(*.xls*),*.xls*", 1, "Âûáðàòü Excel ôàéëû", , False)
    If VarType(avFiles) = vbBoolean Then
        Exit Sub
    End If
    TextBox1.Text = avFiles

'Application.WindowState = xlMinimized
Set oWb = GetObject(avFiles)
End Sub

Public oWb As Workbook
Public newWb As Workbook
Public WsCnt As Integer
Public iColF As Integer
Option Base 1


Sub Main()
    
Dim i As Integer, j As Integer, k As Integer, iColNum As Integer, iHollow As Integer    'счетчики
iColNum = 1                                                     'номер колонки OutputTable
Dim FSName

Set newWb = Workbooks.Add  
.......<Код>........      
End Sub
'--------------------------------------------------------------------------------------------Третья процедура--------------------------------------------
Sub TRI(j As Integer, iColNum As Integer)
Dim sID As String, sNumPNA As String, sQtPNA As String
Dim arrPA() As String
Dim CountPNS1 As Integer, CountPNS2 As Integer, count As Integer
CountPS1 = 0
CountPS2 = 0
count = 0
sNumPS = oWb.Sheets(WsCnt).Cells(j + 1, iColF + 1).Value
arrPA() = Split(sNumPS, ",")                                      '
If UserForm1.iT = 1 Then                                           '

    sID = "1,2"
    For count = LBound(arrPA) To UBound(arrPA)

        If arrPA(count) >= 5 And arrPA(count) <= 9 Then           '
            CountPS1 = CountPS1 + 1
        ElseIf arrPA(count) >= 11 And arrPA(count) <= 12 Then     '
            CountPS2 = CountPS2 + 1
        End If
    Next count
        sQtPA = CountPS1 & "," & CountPS2
        newWb.Sheets(1).Cells(7, iColNum).Value = sQtPA            '
        sID = "1,2"

ElseIf UserForm1.iTU = 2 Or UserForm1.iTU = 3 Then                  '
    newWb.Sheets(1).Cells(7, iColNum).Value = oWb.Worksheets(Wshcnt).Cells(j, iColFind + 1).Value
    sID = "1"
End If

newWb.Sheets(1).Cells(6, iColNum).Value = sPNSID                    '


End Sub