Очередной макрос копирования-вставки

Дата: Понедельник, 20.01.2014, 22:36 | Сообщение № 1

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Всем привет!
В рамках автоматизации табличной работы понадобилось написать простой макрос копирования с двух листов (ДС и ДС1) на третий (Доп) последовательно. Первую строку на "Доп" оставить пустой, далее без пробелов. Количество строк на ДС и ДС1 может быть разным; количество столбцов - одинаковое.
Посетив несколько форумов, написала следующий текст:
[vba]

Код

Private Sub Copy()
ActiveWorkbook.Sheets("Доп").Activate
With Sheets("ДС")
       Range("A2").Copy.Cells(Rows.Count, 2).End (xlUp)
       ActiveSheet.Paste
End With
With Sheets("ДС1")
       Range("A2").Copy.Cells(Rows.Count, 2).End (xlUp)
       ActiveSheet.lastUsedRow.Paste.Offset -1
End With
End Sub

[/vba]

Программа ругается на третью строчку. Т.к. я не разбираюсь, прошу у профи помочь скорректировать (файл на всякий случай прикрепила).

Сообщение отредактировал Nat - Понедельник, 20.01.2014, 22:41

Дата: Понедельник, 20.01.2014, 23:33 | Сообщение № 2

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

И кто Вас учил так называть макросы? Copy - зарезервированное слово VB. Не стоит.
[vba]

Код

Private Sub NatCopy()
     Dim sh As Worksheet
     With ThisWorkbook
         Set sh = .Sheets("Доп")
         With .Sheets("ДС")
             sh.Range("A2").Copy .Cells(.Rows.Count, 2).End(xlUp)(2)
         End With
         With .Sheets("ДС1")
             sh.Range("A2").Copy .Cells(.Rows.Count, 2).End(xlUp)(2)
         End With
     End With
End Sub

[/vba]

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Дата: Вторник, 21.01.2014, 11:26 | Сообщение № 3

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Ок, не буду. Скопировала Ваш марос в файл...в нем что-то не то, не работает

Кстати, по ходу я файл в первое сообщение забыла прикрепить - исправляюсь

Дата: Вторник, 21.01.2014, 11:27 | Сообщение № 4

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Ок, не буду. Скопировала Ваш марос в файл...в нем что-то не то, не работает

Кстати, по ходу я файл в первое сообщение забыла прикрепить - исправляюсь

Дата: Вторник, 21.01.2014, 11:34 | Сообщение № 5

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

А файла так и нет. Если он больше 100 кб - запакуйте его в рар. Мне пора уходить, вернусь - посмотрю. Или кто-нить еще из форумчан посмотрит

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

RAN

Дата: Вторник, 21.01.2014, 12:09 | Сообщение № 6

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

"Ты спутал, батя..."

[vba]

Код

.Cells(.Rows.Count, 2).End(xlUp)(2).Copy sh.Range("A2")

[/vba]

Быть или не быть, вот в чем загвоздка!

Дата: Вторник, 21.01.2014, 14:45 | Сообщение № 7

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

Наверное, Андрюш. Но смысл копировать два раза в одну ячейку? Подождем примера.

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Дата: Вторник, 21.01.2014, 16:56 | Сообщение № 8

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

Убрала все лишнее, пример во вложении.

К сообщению приложен файл: 9194997.xlsm (63.7 Kb)

Дата: Вторник, 21.01.2014, 17:03 | Сообщение № 9

Группа: Проверенные

Ранг: Старожил

Сообщений: 2369

Репутация: 486 ±

Замечаний: 0% ±

2003-2010

[vba]

Код

Private Sub NatCopy()
     Dim sh As Worksheet
     With ThisWorkbook
         Set sh = .Sheets("Доп")
         With .Sheets("ДС")
             .Range("A2").CurrentRegion.Copy sh.Cells(.Rows.Count, 1).End(xlUp)(2)
         End With
         With .Sheets("ДС1")
             .Range("A2").CurrentRegion.Copy sh.Cells(.Rows.Count, 1).End(xlUp)(2)
         End With
     End With
End Sub

[/vba]

Ну с НДС и мы чего-то стoим! kuklp60@gmail.com
WM Z206653985942, R334086032478, U238399322728

Дата: Вторник, 21.01.2014, 17:50 | Сообщение № 10

Группа: Пользователи

Ранг: Участник

Сообщений: 50

Репутация: 0 ±

Замечаний: 0% ±

Excel 2010

KuklP, спасибо, все отлично работает!