WorkBooks.Open

Sub Макрос1()
Dim FilePath$
Dim WbRead As Workbook
Dim TWB As Workbook
Dim o
    With Application.FileDialog(msoFileDialogFilePicker)
        .Title = "Папка для работы с файлами"
        .ButtonName = "Select": .AllowMultiSelect = False
        If .Show Then FilePath = .SelectedItems(1) Else Exit Sub
    End With
    Set WbRead = Workbooks.Open(Filename:=FilePath, ReadOnly:=True)
    Set o = CreateObject("Scripting.dictionary")
    With WbRead.Worksheets("Анкета Общая")
    o.Add 6, .Cells(5, 3)
    o.Add 26, .Cells(8, 3)
    o.Add 27, .Cells(12, 3)
    o.Add 29, .Cells(14, 3)
    o.Add 28, .Cells(16, 3)
    o.Add 30, .Cells(31, 3)
    o.Add 31, .Cells(35, 3)
    End With
    Dim i As Integer
    Set TWB = ThisWorkbook
    For i = 6 To 31
        If (o.exists(i)) Then
           TWB.Worksheets("Ввод данных").Cells(i, 2) = o(i)
        End If
    Next i
    Application.DisplayAlerts = False
    WbRead.Close
    Application.DisplayAlerts = True
End Sub