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
Sub start()
ПутьКПапке = GetFolderPath("Заголовок окна", ThisWorkbook.Path)
If ПутьКПапке = "" Then Exit Sub
MsgBox "Выбрана папка: " & ПутьКПапке, vbInformation
Sheets("Заявки").Visible = True
Sheets("Системный").Visible = True
Workbooks.Open ПутьКПапке & "хранение" & ".xls"
Application.ScreenUpdating = False
Workbooks("хранение.xls").Worksheets("$$$29106").Range("A1:FZ200").Copy
Workbooks("Журнал прихода-расхода.xlsm").Activate
Sheets("Заявки").Activate
ActiveWorkbook.Worksheets("Заявки").Range("A1").Select
ActiveSheet.Paste

Workbooks.Open ПутьКПапке & "хранение*" & ".xls*"

Sub Макрос2() 
' 
Range(Cells(4, 1), Cells(94, 1)).Select 
Selection.Copy 
For i = 1 To 10 Step 3 
Range(Cells(4, i), Cells(94, i)).Select 
ActiveSheet.Paste 
Next i 
End Sub

Sub IronFelix()
' IronFelix Макрос
    Sheets("Системный").Select
    SolverLoad LoadArea:="$U$3:$U$21"
    SolverOk SetCell:="$I$24", MaxMinVal:=2, ValueOf:=0, ByChange:="$A$30:$B$30", _
        Engine:=1, EngineDesc:="GRG Nonlinear"
    SolverSolve UserFinish:=True
    Range("A30:B30").Select
    Selection.Copy
    Sheets("Анализ").Select
    Range("E2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
End Sub