Почему ошибка при копировании?

[valerij]

Опять у меня не работает поиск по форуму......., вынужден спросить
Вот так, работает:

Sub КопиДанные()
Windows("Апрель.xls").Activate
    Sheets("ЛЕН").Select
    Range("D3:G43").Copy
Windows("М А Й.xls").Activate
    Sheets("ЛЕН").Select
    Range("D3:G43").Select
    ActiveSheet.Paste
End Sub

А так, ошибка, а почему?

Sub КопиДанные()
Windows("Апрель.xls").Activate
    Sheets("ЛЕН").Select
    Range("D3:G43").Copy
Windows("М А Й.xls").Activate
    Sheets("ЛЕН").Select
    Range("D3:G43").Paste
    'ActiveSheet.Paste
End Sub

И еще, если надо скопировать, несколько диапазонов(Range("K37:K42"), Range("H47:H55")), мне, что все диапазоны надо выделяnь, копировать, вставлять по очереди??

Sub КопиДанные()
Windows("Апрель.xls").Activate
    Sheets("ЛЕН").Select
    Range("D3:G43").Copy
Windows("М А Й.xls").Activate
    Sheets("ЛЕН").Select
    Range("D3:G43").Select
    ActiveSheet.Paste
Windows("Апрель.xls").Activate
    Sheets("ЛЕН").Select
    Range("K37:K42").Copy
Windows("М А Й.xls").Activate
    Sheets("ЛЕН").Select
    Range("K37:K42").Select
    ActiveSheet.Paste
Windows("Апрель.xls").Activate
    Sheets("ЛЕН").Select
    Range("H47:H55").Copy
Windows("М А Й.xls").Activate
    Sheets("ЛЕН").Select
    Range("H47:H55").Select
    ActiveSheet.Paste
End Sub

Вот, такой получился макрос для копирования данных с одной книги в другую, но слишком медленный.

Sub КопиДанные()
Dim dIap As Long
dIap = 3
    Application.EnableEvents = False
    Application.ScreenUpdating = False
For L = 1 To 9 'L - Листы 9 шт
dIap = 3
Do
Windows("Апрель.xls").Activate
    Sheets(L).Select
    Range(Cells(dIap, 2), Cells(dIap + 40, 7)).Copy
Windows("М А Й.xls").Activate
    Sheets(L).Select
    Range(Cells(dIap, 2), Cells(dIap + 40, 7)).Select
    ActiveSheet.Paste
Windows("Апрель.xls").Activate
    Sheets(L).Select
    Range(Cells(dIap + 34, 11), Cells(dIap + 39, 11)).Copy
Windows("М А Й.xls").Activate
    Sheets(L).Select
    Range(Cells(dIap + 34, 11), Cells(dIap + 39, 11)).Select
    ActiveSheet.Paste
Windows("Апрель.xls").Activate
    Sheets(L).Select
    Range(Cells(dIap + 44, 8), Cells(dIap + 51, 8)).Copy
Windows("М А Й.xls").Activate
    Sheets(L).Select
    Range(Cells(dIap + 44, 8), Cells(dIap + 51, 8)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    dIap = dIap + 54
    Loop While Not dIap > 1674
Next
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

[IgorGO]

А так, ошибка, а почему?
Range("D3:G43").Paste

потому, что у обьекта Range нет метода Paste а у обьекта WorkSheet есть.

Вот это все
Windows("Апрель.xls").Activate
Sheets("ЛЕН").Select
Range("D3:G43").Copy
Windows("М А Й.xls").Activate
Sheets("ЛЕН").Select
Range("D3:G43").Paste
'ActiveSheet.Paste


можно заменить одной строкой:

WorkBook("Апрель.xls").Worksheets("ЛЕН").Range("D3:G43").Copy _
    destination:=WorkBook("М А Й.xls").Worksheets("ЛЕН").).Range("D3")

небось для мая месяца будет новая процедура написана, которая скопирует все на июнь? угадал?

вот так сделай:

Sub КопиДанные(m as integer)
WorkBook(FileN(m)).Worksheets("ЛЕН").Range("D3:G43").Copy _
    destination:=WorkBook(FileN(m+1)).Worksheets("ЛЕН").).Range("D3")
End Sub

и пользуйся этим каждый месяц

Напиши только функцию FileN, которая по номеру месяца, вернет название файла. Обрати внимание, так как я написал, надо чтобы для месяца 13 FileN вернула "январь.xls".

Медленно, понятно. Как написано так и работает. Чем меньше будешь пользоваться Activate и Select, тем быстрее будет все работать.

[valerij]

Сообщение от IgorGO

небось для мая месяца будет новая процедура написана, которая скопирует все на июнь? угадал?.

Нет, мой Уважаемый Игорек, не угадал.
Мне каждый месяц приходится делать, следующее:
В офисе данные введены, скажем по Х число, а дома Х-5, я беру тот же файл(Х-5), переименовываю его(ZXC) и оба открываю и из Х в ручную переношу все данные в ZXC, почему так я делаю, долго объяснять, но уже надоело, вот почему решил автомат, сделать.

[valerij]

Сообщение от IgorGO

можно заменить одной строкой:

WorkBook("Апрель.xls").Worksheets("ЛЕН").Range("D3:G43").Copy _
    destination:=WorkBook("М А Й.xls").Worksheets("ЛЕН").).Range("D3")

Ошибку выдает "Sub or Function not defined"

Sub КопиДанные()
Workbook("Апрель.xls").Worksheets("ЛЕН").Range("D3:G43").Copy _
    Destination:=Workbook("М А Й.xls").Worksheets("ЛЕН").Range("D3")
End Sub

[IgorGO]

писал просто здесь, ексель не открывал. там опечатка (два раза):
WorkBooks("Апрель.xls").Worksheets("ЛЕН").Ra nge("D3:G43").Copy _
destination:=WorkBooks("М А Й.xls").Worksheets("ЛЕН").).Range(" D3")
собственно эксель снова не открывал. воспринимай это не как готовый код, а как болванку, которую возможно надо будет тщательно подогнать напильником дома.

[valerij]

Сообщение от IgorGO

писал просто здесь, ексель не открывал. там опечатка (два раза):
WorkBooks("Апрель.xls").Worksheets("ЛЕН").Ra nge("D3:G43").Copy _
destination:=WorkBooks("М А Й.xls").Worksheets("ЛЕН").).Range("D3").

Тогда три, раза, но не страшно, все работает.
Игорь, но это один диапазон для копии("D3:G43"), а для "К37:К42", "Н47:Н54", я должен, то же самое повторить еще два раза и на Cells могу перейти??

[EducatedFool]

Sub КопиДанные()
    Application.EnableEvents = False: Application.ScreenUpdating = False

    Dim Апрель As Workbook: Dim Май As Workbook
    Set Апрель = Workbooks("Апрель.xls"): Set Май = Workbooks("М А Й.xls")

    Dim shАпрель As Worksheet: Dim shМай As Worksheet

    For L = 1 To 9    'L - Листы 9 шт
        dIap = 3
        Set shАпрель = Апрель.Worksheets(L): Set shМай = Май.Worksheets(L)

        Do
            shАпрель.Range(shАпрель.Cells(dIap, 2), shАпрель.Cells(dIap + 40, 7)).Copy _
                    shМай.Range(shМай.Cells(dIap, 2), shМай.Cells(dIap + 40, 7))

            shАпрель.Range(shАпрель.Cells(dIap + 34, 11), shАпрель.Cells(dIap + 39, 11)).Copy _
                    shМай.Range(shМай.Cells(dIap + 34, 11), shМай.Cells(dIap + 39, 11))

            shАпрель.Range(shАпрель.Cells(dIap + 44, 8), shАпрель.Cells(dIap + 51, 8)).Copy _
                    shМай.Range(shМай.Cells(dIap + 44, 8), shМай.Cells(dIap + 51, 8))

            dIap = dIap + 54
        Loop While Not dIap > 1674

    Next

    Application.EnableEvents = True
End Sub

[valerij]

Сообщение от EducatedFool

Sub КопиДанные()
    Application.EnableEvents = False: Application.ScreenUpdating = False 
   Dim Апрель As Workbook: Dim Май As Workbook....

Игорь, все работает, быстро, НО(как бы правильно сказать) ...
Получается, что просто вставляет числа, НЕ происходит перерасчет, т. е. если F3 = D3 * E3 то в D3 вставилось число, а в F3 =0, а Е3 = 2,50
че не так?

макрос IgorGO, делает перерасчет

[valerij]

Ага, разобрался, если закомментирую Application.EnableEvents = False, то все ОК.
Но
Странно ведет, если L = 9, ошибка "Method 'Intersect' of object '.Global' failed", а если в ручную ставлю L от 1 до 9 то все отлично, странно!
C макросом IgorGO, то же самое

Sub КопиДанные()
UnProtectAllSheets 'Снимаем Защиту с Листов
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim L As Byte, ixd As Long
For L = 1 To 9
ixd = 3
Do
Workbooks("Апрель.xls").Worksheets(L).Range("B" & ixd & ":G" & ixd + 40).Copy _
Destination:=Workbooks("М А Й.xls").Worksheets(L).Range("B" & ixd)

Workbooks("Апрель.xls").Worksheets(L).Range("H" & ixd + 44 & ":H" & ixd + 51).Copy _
Destination:=Workbooks("М А Й.xls").Worksheets(L).Range("H" & ixd + 44)

Workbooks("Апрель.xls").Worksheets(L).Range("K" & ixd + 34 & ":K" & ixd + 39).Copy _
Destination:=Workbooks("М А Й.xls").Worksheets(L).Range("K" & ixd + 34)

ixd = ixd + 54
Loop While Not ixd > 1674
Next
Application.EnableEvents = True
ProtectAllSheets 'Ставим Защиту Листов
End Sub