Sub Сбор()Dim NewFiles
Dim wbActNew As WorkbookNewFiles = Application.GetOpenFilename("Excel files(*.xls*),*.xls*", , "Выберите файл", , False)
If VarType(NewFiles) = vbBoolean Then Exit Sub
Set wbActNew = Workbooks.Open(Filename:=NewFiles)End Sub

Sub Замена()
ThisWorkbook.Worksheets(1).Range("A3").Replace What:="СРЗНАЧ", Replacement:="МИН", _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False       
End Sub

Sub Прогноз_ИТОГ_14()
    Dim g As Range
      Set g = Range("V9")
     
     For i = 1 To 5
With Worksheets(3)
   Cells.Replace What:="MR00r  Москва", Replacement:=.g.Value, _
        LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:= _
        False, ReplaceFormat:=False
        .Activate
    End With
g = g.Offset(1, 0)
        Set s = Worksheets(3)
        s.Name = s.g
        s.Copy
        ActiveWorkbook.SaveAs "C:\Users\macher13\Desktop\План-факт по регионам\2016" & "\" & s.Name & ".xlsx"
        ActiveWorkbook.BreakLink Name:="\\0000rtcfs01\fs_disk_k\WorkData\РАСЧЕТ.xlsx" _
        , Type:=xlExcelLinks
        
       ActiveWorkbook.Close
       Next
End Sub