копирование данных из одной книги ексель в другую

[ncux0075]

Добрый день. Из одной книги открываю другие и копирую данные, структура таблиц одинакова, меняется кол-во строк. написанный код ниже почему то не работает, все ругается на рейндж.
Private Sub CommandButton21_Click()
Dim i As Long
Dim nam As Variant
Dim st As Variant
Dim sr As Variant
Dim iSource As Worksheet
For i = 1 To 1
nam = i
Workbooks.Open Filename:=adr & nam & ".xlsx"




'определяем диапазон что нужно скопировать
st = 1
sr = 1
Do Until IsEmpty(Cells(st, 1))
st = st + 1
Loop
Do Until IsEmpty(Cells(1, sr))
sr = sr + 1
Loop
' выделяем и копируем

ActiveSheet.Range(Cells(1, 1), Cells(st, sr)).Copy




sti = 1

Do Until IsEmpty(Cells(st, 1))
sti = st + 1
Loop

ActiveSheet.Paste


Next i


End Sub

[Aleksandr H.]

1 Зачем For 1 => 1 ?
2 последнии ячейки можна так определять http://forum.sources.ru/index.php?showtopic=93671#
3 приложите пример данных входа/выхода

[ncux0075]

диапазон больше будет, просто сейчас один для примера.

знаю есть другой способ определения это я так накидал просто на скорую руку.

у меня вся суть заключается что я активирую открытую книгу, и не могу с него скопировать, т.к он выделяется диапазон и копирует с книги где находиться кнопка. А activatesheet не подходит для range. я так сам разберусь просто завал на работе. думал кто подскажет где косячу.

[Aleksandr H.]

ActiveSheet.Range(Cells(1, 1), Cells(st, sr)).Copy - ета строка нормально работает? если да, тогда
ActiveSheet.Paste заменить на ActiveSheet.cells(СТРОКА, СТОЛБЕЦ).Paste

[ncux0075]

нет ругается application-defined or object-defined error

если убрать activesheet то ругаться перестает.

но ругается дальше на то где вставить. а без activesheet он диапазон копирует с книги где кнопка

[Aleksandr H.]

о5 же, сложно без файла угадывать.

вместо .Paste напишите .PasteSpecial xlPasteValues

[ncux0075]

ну вот подделал.

Sub Кнопка4_Щелчок()
Dim nstr As Integer
Dim nstl As Integer
Dim kn1 As Workbook
Dim kn2 As Workbook
Dim shkn1 As Worksheet
Dim shkn2 As Worksheet
'Set kn1 = Workbooks("Свод1.xlsm")


Dim i As Long
For i = 1 To 1
Set kn2 = Workbooks.Open(adr & i & ".xlsx")
'определяем последнюю заполненую строку
nstr = kn2.Worksheets(1).Cells(kn2.Workshe ets(1).Rows.Count, 1).End(xlUp).Row
'определяем последний заполненый столбец
nstl = kn2.Worksheets(1).Cells(1, kn2.Worksheets(1).Columns.Count).En d(xlToLeft).Column
kn2.Worksheets(1).Range(Cells(1, 1), Cells(nstr, nstl)).Copy
'kn1("Свод1.xlsm").Worksheets("Лист 1").Range(Cells(1, 1), Cells(nstr, nstl)).Paste
'kn1.Worksheets("Лист1").Activate

Windows("Свод1.xlsm").Activate
Range("A1").Select
до этой строки все делает копирует диапазон, возвр в ячейку а1, а после ошибка
ActiveSheet.Paste


Next i
End Sub