Option Explicit
Option Compare Text

Sub CreateNewFiles()

    Dim fd          As FileDialog
    Dim fso         As New FileSystemObject
    Dim aFile       As File
    Dim sMask       As String
    Dim sNumber     As String
    Dim sNewName    As String
    Dim sFileName   As String
    Dim sFullPath   As String
    Dim sExtension  As String
    Dim sSubFolder  As String
    Dim sRootFolder As String
    
    ' Select target folder.
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' If user selected nothing, exit sub.
    If fd.Show = False Then Exit Sub
    
    ' Get root folder path.
    sRootFolder = fd.SelectedItems( 1 )
    
    ' Define mask.
    sMask = "Набор-*"
    
    ' Create new sub-folder. It will be located in the root folder.
    ' Create path to sub-folder.
    sSubFolder = sRootFolder & "\NewFiles"
    
    ' If sub-folder already exists, delete it.
    If fso.FolderExists(sSubFolder) Then fso.DeleteFolder sSubFolder, True
    
    ' Create sub-folder.
    fso.CreateFolder sSubFolder
    
    
    ' Process each and every file.
    For Each aFile In fso.GetFolder(sRootFolder).Files
        
        ' Get file extension.
        sExtension = fso.GetExtensionName(aFile.Name)
        
        ' If it's an Excel file, process it further.
        If sExtension Like "xls*" Then
            
            ' Get file name without extension.
            sFileName = fso.GetBaseName(aFile.Name)
            
            ' Check whether file name matches mask.
            If sFileName Like sMask Then
                
                ' Get number.
                ' InStrRev searches for "-" from right to left.
                sNumber = Right$(sFileName, Len(sFileName) - InStrRev(sFileName, "-"))
                
                ' Create new Excel file name.
                sNewName = "Итог-" & sNumber
                                
                ' Create full path to new Excel file.
                sFullPath = sSubFolder & "\" & sNewName & "." & sExtension
                
                ' Copy original file to sub-folder.
                aFile.Copy sFullPath
                
            End If
            
        End If
        
    Next
    
End Sub

Dim PagePar As Worksheet
....
For Each aFile In fso.GetFolder(sRootFolder).Files
...
    Set PagePar = Workbooks.Open(aFile.Path).Sheets("Page1")

Sub ForNextLoop()

    Dim i As Long
    
    For i =  1  To  100 
       ' Мы нашли, что ячейка непуста => содержит данные.
       ' Вместо Cells(i, "C") можно написать Cells(i, 3).
        If Not IsEmpty(Cells(i, "C")) Then
            ' Обработка.
        End If
    Next

End Sub

        If (Cells(i, "C"))<>"" Then
            ' Обработка.
        End If

If Range("C1")=""...