генерация книг

[Slamfist]

Здравствуйте, хотел обратиться к вам за помощью.
Начальство поставило перед фактом - делай. Почти все что нужно сделал, но все, что делал не связано с VBA. А последний момент не обойти без этого.

Суть: есть "Книга1" и "Книга2". "Книга2" - представляет роль некой БД. К примеру на лист1 в столбец А вбиваются цифры от 1 до ...неизвестно. А в "Книга1" при нажатии на кнопку, одной ячейки(к примеру B2) присваивается значение из ячейки A1 "книга2", после этого "книга1" сохраняется с именем типа "1.xls". И так происходит пока не встретит пустую ячейку в столбце А "книга2".

Т.е. при нажатии на кнопку создаются книги с именами из столбца А "книга2".

Заранее спасибо.

[Slamfist]

хотя бы подскажите как правильно записать цикл:

for i = 1 to j?
if len(workbooks("Книга2.xls).Sheets("Лист1").Cells(1, i)) <> 0 then
     workbooks("Книга1.xls).Sheets("Лист1").Range("B2") = workbooks("Книга2.xls).Sheets("Лист1").Cells(1, i)) 
     ActiveWorkbook.SaveCopyAs Filename:=CStr(Worksheets("Лист1").Range("B2")) + ".xls"
else
j = i
end if
next

[Maxx]

Sub CreateBooks()
Dim wB1, wB2, newBook: Application.ScreenUpdating = False
     Range([B2], Cells(Cells(Rows.Count, 2).End(xlUp).Row, 2)).ClearContents
     Set wB1 = ThisWorkbook
     Set wB2 = Workbooks.Open(ThisWorkbook.Path & "\Книга2.xls")
     
     For i = 1 To wB2.Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
        iiName = wB2.Sheets(1).Cells(i, 1).Value
        newBook = ThisWorkbook.Path & "\" & iiName & ".xls"
        wB1.Sheets(1).Cells(i + 1, 2).Value = iiName & ".xls"
        Workbooks.Add: ActiveWorkbook.SaveAs Filename:=newBook:
        ActiveWorkbook.Close True
    Next i
    wB2.Close False: Application.ScreenUpdating = True
End Sub

Вот пример (запустите файл Книга1 и нажмите кнопку):

[Slamfist]

Спасибо, то что нужно)