Переформатирование - VBA

Формулировка задачи:

Друзья, подскажите пожалуйста.

Sub example_02()
Dim x, y(), i&, j&, s$
x = ActiveSheet.UsedRange.Value
If IsArray(x) Then
 ReDim y(1 To UBound(x))
 For i = 1 To UBound(x)
 For j = 1 To UBound(x, 2)
 y(i) = y(i) & ";" & x(i, j)
 Next j
 Next i: s = Join(y, vbCrLf)
Else
 s = x
End If
With CreateObject("scripting.filesystemobject")
 With .CreateTextFile("C:\Users\Афанасьев\Desktop\TXT" & "\sheet44.txt", True)
 .Write s: .Close
 End With
End With
MsgBox "Ok", 64
End Sub

имеется код, который преобразовывает активный лист книги и сохраняет по заданному адресу в формате TXT Подскажите как допилить, чтобы он переформатировал не только ActiveSheet, а все листы книги и создавал отдельные файлы txt с названием этих листов. И как бы пристроить возможность выбора файла

vFiles = Application.GetOpenFilename _
    ("Excel files(*.xls*),*.xls*,Text files(*.txt),*.txt", 2, "Г‚Г»ГЎГ°Г*ГІГј ГІГҐГЄГ±ГІГ®ГўГ»ГҐ ГЁГ«ГЁ Excel ГґГ*Г©Г«Г»", , False)

И куда сохранять эти текстовички

Решение задачи: «Переформатирование»

textual
                            Листинг программы 
                        

                            Application.ScreenUpdating = False
For i = 1 To Sheets.Count
    x = Sheets(i).UsedRange.Value
    If IsArray(x) Then
    ReDim y(1 To UBound(x))
          For i = 1 To UBound(x)
               For j = 1 To UBound(x, 2)
                      y(i) = y(i) & ";" & x(i, j)
               Next j
          Next i: s = Join(y, vbCrLf)
    Else
          s = x
    End If
    With CreateObject("scripting.filesystemobject")
        With .CreateTextFile("C:\Users\Афанасьев\Desktop\TXT\" & Sheets(i).Name & ".txt", True)
              .Write s: .Close
        End With
    End With
    MsgBox "Ok", 64
Next
Application.ScreenUpdating = True
                        