Импорт данных с закрытой книги в Excel

[Mint86]

Здравствуйте, есть такая задача, необходимо осуществить импорт с закрытой книги Excel в открытую. Принцип такой. При выполнении макроса открывается диалоговое окно выбора папки где лежит файл данные с которого надо экспортировать. После выбора папки (в данной папке будет только один файл excel), макрос должен считать данные в каждой ячейке определенного диапазона и записать эти данные в определенные ячейки в книге куда импортируются данные.
Во вложении я попытался что-то сделать, единственно "встал" на цикле. Т.е. нужно организовать цикл (или другой способ) чтобы не писать каждый раз почти один и тот же код для каждой ячейки диапазона с которого идет импорт.

Задача всей этой "процессии" такая: пользователь работает с книгой Excel, вбивает в определенные поля данные потом после того как закончит работу делает экспорт данных (экспорт я планирую сделать просто копипастом). Потом работает с данной же книгой но уже забивает другие данные. Если ему понадобится загрузить старые данные, то он просто импортирует ранее экспортированные данные чтобы не вбивать вручную заново. Книга одна, пересохранять под другим именем нельзя (почему не важно - так стоит задача). Требуется именно импорт данных.

Спасибо.

[Djeki]

Если название листов во всех закрытых книгах одинаковое, и известны адреса ячеек из которых надо взять данные не открывая файл - то можно..Книгу Main.xls откройте, кнопку нажмите и из папки Base берём данные , не открывая файлы..
Если в закрытой книге один единственный лист, то название листа может быть любое.. Т.е. сложив в папку файлы, в каждом из которых по одному листу, можно брать данные из определённых ячеек а названия листов могут быть различные в этих книгах..

[SAS888]

Посмотрите вложение. GetValue выделена в отдельную функцию, которая вызывается из макроса "import" в цикле. Подставьте требуемые значения строк и столбцов.

[Mint86]

Спасибо друзья буду пробовать. Потом отпишусь...

[Mint86]

Друзья с импортом более менее разобрался, появился вопрос с экспортом данных. Есть код:

Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" _
                                     (ByVal hwnd As Long, ByVal pszPath As String, _
                                      ByVal psa As Any) As Long
Sub CreateFolderWithSubfolders(ByVal ПутьСоздаваемойПапки$)
    
    If Len(Dir(ПутьСоздаваемойПапки$, vbDirectory)) = 0 Then
        SHCreateDirectoryEx Application.hwnd, ПутьСоздаваемойПапки$, ByVal 0&
    End If

End Sub
Sub ExportAnk()
    
    'On Error GoTo er1
    Application.ScreenUpdating = False
    
    Подпапка = "ФИО клиента"
    путь = "C:\Клиенты\" & Подпапка
 
    CreateFolderWithSubfolders путь
    
    
    r1 = Range("AA7")
    r2 = Range("I11")
    r3 = Range("I13")
    r4 = Range("X13")
    r5 = Range("I15")
    r6 = Range("X15")
    r7 = Range("I17")
    r8 = Range("V17")
    r9 = Range("X17")
    r10 = Range("I19")
   
    Application.Workbooks.Add
    
'    ActiveWorkbook.Sheets("Лист1").Range("A1") = r1
'    ActiveWorkbook.Sheets("Лист1").Range("A2") = r2
'    ActiveWorkbook.Sheets("Лист1").Range("A3") = r3
'    ActiveWorkbook.Sheets("Лист1").Range("A4") = r4
'Вместо ActiveWorkbook.Sheets("Лист1").Range("A1") = r1 (r2 итд) хочется цикл устроить...
   
    For i = 1 To 160
        ActiveWorkbook.Sheets("Лист1").Cells(i, 1).Value = r & i ' вот здесь нужна помощь! 
        
    Next
    
  
    имя = путь & "\" & "Экспорт.xls"
    
    ActiveWorkbook.SaveAs Filename:=имя
 
    
    MsgBox "Экспорт осуществлён в попку: " & путь
'    GoTo ends1
'
''er1: MsgBox "Файл с таким именем в папке " & путь & " уже существует и на данный момент открыт"
'
'ends1:

Application.ScreenUpdating = True

End Sub

Нужно подправить цикл. Ставлю ActiveWorkbook.Sheets("Лист1").Cell s(i, 1).Value = r & i копируется только порядковые номера. Пробовал вместо r & i написать "r" & i но тогда пишется r1 r2 и тд. как сделать так чтобы бралось значение сохраненное ранее в переменных r1, r2 ...
Не охото писать каждый раз ActiveWorkbook.Sheets("Лист1").Rang e("A1") = r1 (r2, r3 ...)

[SAS888]

ActiveWorkbook.Sheets("Лист1").Cell s(i, 1).Value = r & i ' вот здесь нужна помощь!

Не совсем понятно, что Вы хотите получить в ячейке ActiveWorkbook.Sheets("Лист1").Cell s(i, 1). Если значение переменной r1 (r2, r3 и т.д.), то к переменной нельзя так обращаться (r & i). Нужно создать массив, например r(1 To 10), присвоить элементам массива значения: r(1) = Range("AA7") и т.д., а затем использовать обычное обращение

ActiveWorkbook.Sheets("Лист1").Cells(i, 1).Value = r(i)

[Mint86]

SAS888 огромное спасибо, именно это и нужно было.