Sub DownloadPages()
'
' Макрос1 Макрос
'

'
    'отключаем отображения
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    On Error Resume Next
    
    Dim iteratorID As Long
    
    Dim curBook As Workbook
    Dim curSheet As Worksheet
    
    Dim path As String
    
    path = GetFolderPath("Выберите папку для сохранения", ThisWorkbook.path)
    
    For iteratorID = 1 To 10000  '20000
        Set curBook = Application.Workbooks.Add

        Set curSheet = curBook.ActiveSheet
        
        
        With curSheet.QueryTables.Add(Connection:= _
            "URL;http://www.rlsnet.ru/mnn_index_id_" & iteratorID & ".htm", Destination:=Range("$A$1"))
            '.CommandType = 0
            .Name = "mnn_index_id_" & iteratorID
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With

        curBook.SaveAs path & "mnn_index_id_" & iteratorID
        curBook.Close
    
    Next
    'включаем отображения
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    MsgBox ("Готово!")
End Sub

Function GetFolderPath(Optional ByVal Title As String = "Выберите папку", _
                       Optional ByVal InitialPath As String = "c:\") As String
    ' функция выводит диалоговое окно выбора папки с заголовком Title,
    ' начиная обзор диска с папки InitialPath
    ' возвращает полный путь к выбранной папке, или пустую строку в случае отказа от выбора
    Dim PS As String: PS = Application.PathSeparator
    With Application.FileDialog(msoFileDialogFolderPicker)
        If Not Right$(InitialPath, 1) = PS Then InitialPath = InitialPath & PS
        .ButtonName = "Выбрать": .Title = Title: .InitialFileName = InitialPath
        If .Show <> -1 Then Exit Function
        GetFolderPath = .SelectedItems(1)
        If Not Right$(GetFolderPath, 1) = PS Then GetFolderPath = GetFolderPath & PS
    End With
End Function