Зацикливание

Private Sub ok_Click()
x = 0
 
With Application
.DefaultFilePath = "C:\BackUp" 
End With
 
Set fs = CreateObject("Scripting.FileSystemObject")
 
If Not fs.FolderExists("C:\BackUp") Then 
    fs.CreateFolder ("C:\BackUp")
End If
Application.DisplayAlerts = True 
 
 
Do While x < TextBox1.Value
x = x + 1
strNewName = x
Application.Workbooks(1).SaveAs strNewName
If x = TextBox1.Value Then Exit Do
Loop
 
End Sub

TextBox1.Value

НазвФормы.Hide

Dim x As Long
Do While x < CLng(TextBox1.Value)

Private Sub ok_Click()
 
With Application
.DefaultFilePath = "C:\BackUp"
End With
 
Set fs = CreateObject("Scripting.FileSystemObject")
 
If Not fs.FolderExists("C:\BackUp") Then
    fs.CreateFolder ("C:\BackUp")
End If
Application.DisplayAlerts = True
 
If TextBox1.Value = "" Then
    MsgBox "Укажите количество копий"
Else
    Dim x As Long
    x = 0
    Do While x < CLng(TextBox1.Value)
    x = x + 1
    strNewName = x
    Application.Workbooks(1).SaveAs strNewName
    If x = CLng(TextBox1.Value) Then Exit Do
    UserForm1.Hide
    Loop
End If
End Sub

Sub Text1()
 
 
Dim Txt
Txt = InputBox("Input")
If Val(Txt) = 0 And Txt <> 0 Then MsgBox ("Txt íå ÷èñëî")
End Sub

Sub FilSystemObject()
Dim oFileSystemObject As Object
Dim x As Long
Set oFileSystemObject = CreateObject("Scripting.FileSystemObject")
x = InputBox("Копирование файлов")
If x > 0 Then
    For x = 1 To CLng(x)
        oFileSystemObject.Copyfile "C:\Копирование\Копировать этот файл.xls", "C:\Копирование\Копировать этот файл_" & x & ".xls"
    Next
End If
End Sub

With Application.FileSearch 'открыть файлы для расчета
            .NewSearch
            .LookIn = dir.Caption
            .FileType = msoFileTypeExcelWorkbooks
            .Execute
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Set WB = Workbooks.Open(.FoundFiles(i), , False)
                
                WB.Activate
                Cells.Select
                Selection.copy
                
                ThisWorkbook.Activate 'создать новый лист i
                Dim newlisto As Worksheet
                Set newlisto = ActiveWorkbook.Worksheets.Add
                newlisto.Name = i
                newlisto.Visible = xlSheetVisible
                              
                ThisWorkbook.Worksheets(i).Activate 'вставить данные из исходной таблицы
                Cells.Select
                ActiveSheet.Paste
                
                Application.CutCopyMode = False 'очистить буфер и закрыть исходную таблицу
                WB.Close
 
                          Next i
        End If
        End With

Dim wbk
 
wbk = ThisWorkbook.Name
 
With Application.FileSearch 'открыть файлы для расчета
            .NewSearch
            .LookIn = dir.Caption
            .FileType = msoFileTypeExcelWorkbooks
            .Execute
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                Set WB = Workbooks.Open(.FoundFiles(i), , False)
WB.Activate
 
ActiveSheet.Move Before:=Workbooks(wbk).Sheets(1)
ActiveSheet.Name=i
 
  WB.Close
 
                          Next i
        End If

ActiveSheet.Copy Before:=Workbooks(wbk).Sheets(1)