Копирование/вставка диапазона
Nikolay86
Дата: Среда, 26.10.2016, 17:18 |
Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 55
Репутация:
0
±
Замечаний:
20% ±
Excel 2007
Добрый вечер. Задача: В файле Primer с листа1 необходимо скопировать диапазон ячеек С20:I26 (количество строк будет постоянно меняться и определяться как "последняя заполненая -8") и вставить на лист2 следующим образом: ячейки столбца "С" листа1 вставить в столбец "B" листа2 начиная с ячейки "В14" и до "последней заполненной -12" (в примере это В24), ячейки столбца "D" листа1 в столбец "С" начиная с С14 и до "последней заполненной -12" и т.д. (в примере понятно какие куда вставлять по названию столбцов) Пояснение: Последние 12 заполненных строк должны оставаться нетронутыми и как бы ползать вниз/вверх по листу в зависимости от количества вставляемых строк.
Добрый вечер. Задача: В файле Primer с листа1 необходимо скопировать диапазон ячеек С20:I26 (количество строк будет постоянно меняться и определяться как "последняя заполненая -8") и вставить на лист2 следующим образом: ячейки столбца "С" листа1 вставить в столбец "B" листа2 начиная с ячейки "В14" и до "последней заполненной -12" (в примере это В24), ячейки столбца "D" листа1 в столбец "С" начиная с С14 и до "последней заполненной -12" и т.д. (в примере понятно какие куда вставлять по названию столбцов) Пояснение: Последние 12 заполненных строк должны оставаться нетронутыми и как бы ползать вниз/вверх по листу в зависимости от количества вставляемых строк. Nikolay86
Сообщение отредактировал Nikolay86 - Среда, 26.10.2016, 17:36
Ответить
Сообщение Добрый вечер. Задача: В файле Primer с листа1 необходимо скопировать диапазон ячеек С20:I26 (количество строк будет постоянно меняться и определяться как "последняя заполненая -8") и вставить на лист2 следующим образом: ячейки столбца "С" листа1 вставить в столбец "B" листа2 начиная с ячейки "В14" и до "последней заполненной -12" (в примере это В24), ячейки столбца "D" листа1 в столбец "С" начиная с С14 и до "последней заполненной -12" и т.д. (в примере понятно какие куда вставлять по названию столбцов) Пояснение: Последние 12 заполненных строк должны оставаться нетронутыми и как бы ползать вниз/вверх по листу в зависимости от количества вставляемых строк. Автор - Nikolay86 Дата добавления - 26.10.2016 в 17:18
sboy
Дата: Среда, 26.10.2016, 17:32 |
Сообщение № 2
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация:
724
±
Замечаний:
0% ±
Excel 2010
И Вам добрый вечер...
И Вам добрый вечер... sboy
Яндекс: 410016850021169
Ответить
Сообщение И Вам добрый вечер... Автор - sboy Дата добавления - 26.10.2016 в 17:32
KuklP
Дата: Среда, 26.10.2016, 17:59 |
Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 2369
Репутация:
486
±
Замечаний:
0% ±
2003-2010
+5 Тут ТС хоть поздоровался, прежде чем понукать форумчанами. Nikolay86 , Техзадания, задачи у нас ставят здесь
+5 Тут ТС хоть поздоровался, прежде чем понукать форумчанами. Nikolay86 , Техзадания, задачи у нас ставят здесь KuklP
Ну с НДС и мы чего-то стoим! kuklp60@gmail.com WM Z206653985942, R334086032478, U238399322728
Ответить
Сообщение +5 Тут ТС хоть поздоровался, прежде чем понукать форумчанами. Nikolay86 , Техзадания, задачи у нас ставят здесь Автор - KuklP Дата добавления - 26.10.2016 в 17:59
sboy
Дата: Четверг, 27.10.2016, 12:06 |
Сообщение № 4
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация:
724
±
Замечаний:
0% ±
Excel 2010
Не сразу... но исправилсяСообщение отредактировал Nikolay86 - Среда, 26.10.2016, 17:36
Не сразу... но исправилсяСообщение отредактировал Nikolay86 - Среда, 26.10.2016, 17:36
sboy
Яндекс: 410016850021169
Ответить
Сообщение Не сразу... но исправилсяСообщение отредактировал Nikolay86 - Среда, 26.10.2016, 17:36
Автор - sboy Дата добавления - 27.10.2016 в 12:06
sboy
Дата: Четверг, 27.10.2016, 14:30 |
Сообщение № 5
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2566
Репутация:
724
±
Замечаний:
0% ±
Excel 2010
Добрый день. Если правильно понял задачу, вот совместное решение с макрорекодером [vba]Код
Sub Скругленныйпрямоугольник1_Щелчок() With ActiveSheet ilr = .Cells(20, 3).End(xlDown).Row irows = ilr - 19 Set rMaterial = .Range(Cells(20, 3), Cells(ilr, 4)) Set rArtikul = .Range(Cells(20, 6), Cells(ilr, 6)) Set rFact = .Range(Cells(20, 9), Cells(ilr, 9)) End With Sheets(2).Activate With ActiveSheet ir1 = .Cells.Find(What:="Наименование материала", After:=ActiveCell, LookIn:= _ xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ xlNext, MatchCase:=False, SearchFormat:=False).Row + 2 ir2 = .Cells.Find(What:="бочки п/эт", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Row - 2 If ir2 > ir1 Then .Rows(ir1 & ":" & ir2).Delete (xlUp) For x = 0 To irows - 1 .Rows(ir1 + x).Insert xlShiftDown Next x rArtikul.Copy .Cells(ir1, 1).Select .Paste rMaterial.Copy .Cells(ir1, 2).Select .Paste rFact.Copy .Cells(ir1, 5).Select .Paste End With End Sub
[/vba]
Добрый день. Если правильно понял задачу, вот совместное решение с макрорекодером [vba]Код
Sub Скругленныйпрямоугольник1_Щелчок() With ActiveSheet ilr = .Cells(20, 3).End(xlDown).Row irows = ilr - 19 Set rMaterial = .Range(Cells(20, 3), Cells(ilr, 4)) Set rArtikul = .Range(Cells(20, 6), Cells(ilr, 6)) Set rFact = .Range(Cells(20, 9), Cells(ilr, 9)) End With Sheets(2).Activate With ActiveSheet ir1 = .Cells.Find(What:="Наименование материала", After:=ActiveCell, LookIn:= _ xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ xlNext, MatchCase:=False, SearchFormat:=False).Row + 2 ir2 = .Cells.Find(What:="бочки п/эт", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Row - 2 If ir2 > ir1 Then .Rows(ir1 & ":" & ir2).Delete (xlUp) For x = 0 To irows - 1 .Rows(ir1 + x).Insert xlShiftDown Next x rArtikul.Copy .Cells(ir1, 1).Select .Paste rMaterial.Copy .Cells(ir1, 2).Select .Paste rFact.Copy .Cells(ir1, 5).Select .Paste End With End Sub
[/vba] sboy
Яндекс: 410016850021169
Ответить
Сообщение Добрый день. Если правильно понял задачу, вот совместное решение с макрорекодером [vba]Код
Sub Скругленныйпрямоугольник1_Щелчок() With ActiveSheet ilr = .Cells(20, 3).End(xlDown).Row irows = ilr - 19 Set rMaterial = .Range(Cells(20, 3), Cells(ilr, 4)) Set rArtikul = .Range(Cells(20, 6), Cells(ilr, 6)) Set rFact = .Range(Cells(20, 9), Cells(ilr, 9)) End With Sheets(2).Activate With ActiveSheet ir1 = .Cells.Find(What:="Наименование материала", After:=ActiveCell, LookIn:= _ xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ xlNext, MatchCase:=False, SearchFormat:=False).Row + 2 ir2 = .Cells.Find(What:="бочки п/эт", After:=ActiveCell, LookIn:=xlFormulas, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False).Row - 2 If ir2 > ir1 Then .Rows(ir1 & ":" & ir2).Delete (xlUp) For x = 0 To irows - 1 .Rows(ir1 + x).Insert xlShiftDown Next x rArtikul.Copy .Cells(ir1, 1).Select .Paste rMaterial.Copy .Cells(ir1, 2).Select .Paste rFact.Copy .Cells(ir1, 5).Select .Paste End With End Sub
[/vba] Автор - sboy Дата добавления - 27.10.2016 в 14:30
Nikolay86
Дата: Четверг, 27.10.2016, 21:42 |
Сообщение № 6
Группа: Пользователи
Ранг: Участник
Сообщений: 55
Репутация:
0
±
Замечаний:
20% ±
Excel 2007
Спасибо и доброй ночи), Вы все правильно поняли, все работает как надо, код понятен! Возникла пара вопросов: почему , а не xlValues мы же вроде как раз значение ищем? И... что такое ТС?) P.S. В моем случае этого конечно не предвидится, но макрос чувствителен к пустым ячейкам в списке материалов ilr = .Cells(20, 3).End(xlDown).Row
просто интересно как в таком случае корректно скопировать все материалы)
Спасибо и доброй ночи), Вы все правильно поняли, все работает как надо, код понятен! Возникла пара вопросов: почему , а не xlValues мы же вроде как раз значение ищем? И... что такое ТС?) P.S. В моем случае этого конечно не предвидится, но макрос чувствителен к пустым ячейкам в списке материалов ilr = .Cells(20, 3).End(xlDown).Row
просто интересно как в таком случае корректно скопировать все материалы)Nikolay86
Ответить
Сообщение Спасибо и доброй ночи), Вы все правильно поняли, все работает как надо, код понятен! Возникла пара вопросов: почему , а не xlValues мы же вроде как раз значение ищем? И... что такое ТС?) P.S. В моем случае этого конечно не предвидится, но макрос чувствителен к пустым ячейкам в списке материалов ilr = .Cells(20, 3).End(xlDown).Row
просто интересно как в таком случае корректно скопировать все материалы)Автор - Nikolay86 Дата добавления - 27.10.2016 в 21:42
Pelena
Дата: Четверг, 27.10.2016, 22:27 |
Сообщение № 7
Группа: Админы
Ранг: Местный житель
Сообщений: 19184
Репутация:
4420
±
Замечаний:
±
Excel 365 & Mac Excel
"Черт возьми, Холмс! Но как??!!" Ю-money 41001765434816
Ответить
Nikolay86
Дата: Понедельник, 07.11.2016, 22:26 |
Сообщение № 8
Группа: Пользователи
Ранг: Участник
Сообщений: 55
Репутация:
0
±
Замечаний:
20% ±
Excel 2007
Доброго времени суток уважаемые форумчане. При доработке макроса под себя столкнулся с трудностями . Предложенное решение от sboy (за что огромное спасибо) работает, но макрос корректно выполняется только с первого листа, а мне необходимо со второго. Нашел решение, но остался вопрос: [vba]Код
Sub Скругленныйпрямоугольник1_Щелчок() 'Sheets(1).Activate '(если раскомментировать то работает с Листа2, но при выполнении макроса "моргает" переключением листов) With ActiveSheet '(Вопрос: почему если вместо ActiveSheet вставить просто ThisWorkbook.Sheets(1) не работает с Листа2? пишет ошибку в строке Set rMaterial = .Ra...) ilr = .Cells(20, 3).End(xlDown).Row irows = ilr - 19 Set rMaterial = .Range(Cells(20, 3), Cells(ilr, 4)) Set rArtikul = .Range(Cells(20, 6), Cells(ilr, 6)) Set rFact = .Range(Cells(20, 9), Cells(ilr, 9)) End With
[/vba]
Доброго времени суток уважаемые форумчане. При доработке макроса под себя столкнулся с трудностями . Предложенное решение от sboy (за что огромное спасибо) работает, но макрос корректно выполняется только с первого листа, а мне необходимо со второго. Нашел решение, но остался вопрос: [vba]Код
Sub Скругленныйпрямоугольник1_Щелчок() 'Sheets(1).Activate '(если раскомментировать то работает с Листа2, но при выполнении макроса "моргает" переключением листов) With ActiveSheet '(Вопрос: почему если вместо ActiveSheet вставить просто ThisWorkbook.Sheets(1) не работает с Листа2? пишет ошибку в строке Set rMaterial = .Ra...) ilr = .Cells(20, 3).End(xlDown).Row irows = ilr - 19 Set rMaterial = .Range(Cells(20, 3), Cells(ilr, 4)) Set rArtikul = .Range(Cells(20, 6), Cells(ilr, 6)) Set rFact = .Range(Cells(20, 9), Cells(ilr, 9)) End With
[/vba] Nikolay86
К сообщению приложен файл:
123.xls
(90.5 Kb)
Сообщение отредактировал Nikolay86 - Понедельник, 07.11.2016, 22:27
Ответить
Сообщение Доброго времени суток уважаемые форумчане. При доработке макроса под себя столкнулся с трудностями . Предложенное решение от sboy (за что огромное спасибо) работает, но макрос корректно выполняется только с первого листа, а мне необходимо со второго. Нашел решение, но остался вопрос: [vba]Код
Sub Скругленныйпрямоугольник1_Щелчок() 'Sheets(1).Activate '(если раскомментировать то работает с Листа2, но при выполнении макроса "моргает" переключением листов) With ActiveSheet '(Вопрос: почему если вместо ActiveSheet вставить просто ThisWorkbook.Sheets(1) не работает с Листа2? пишет ошибку в строке Set rMaterial = .Ra...) ilr = .Cells(20, 3).End(xlDown).Row irows = ilr - 19 Set rMaterial = .Range(Cells(20, 3), Cells(ilr, 4)) Set rArtikul = .Range(Cells(20, 6), Cells(ilr, 6)) Set rFact = .Range(Cells(20, 9), Cells(ilr, 9)) End With
[/vba] Автор - Nikolay86 Дата добавления - 07.11.2016 в 22:26
_Boroda_
Дата: Понедельник, 07.11.2016, 23:06 |
Сообщение № 9
Группа: Модераторы
Ранг: Местный житель
Сообщений: 16675
Репутация:
6481
±
Замечаний:
0% ±
2003; 2007; 2010; 2013 RUS
Немного по-другому написал [vba]Код
Sub tt() Application.ScreenUpdating = 0 With Sheets("Лист1") r10_ = 20 r11_ = .Range("I" & Rows.Count).End(xlUp).Row If r11_ < r10_ Then Exit Sub Else n_ = r11_ - r10_ + 1 End If End With With Sheets("Лист2") r20_ = 14 r21_ = .Range("E" & Rows.Count).End(xlUp).Row If r21_ >= r20_ Then .Rows(r20_ & ":" & r21_).Delete Else r21_ = r20_ End If .Rows(r20_ & ":" & r20_ + n_ - 1).Insert Sheets("Лист1").Range("C" & r10_).Resize(n_, 2).Copy .Range("B" & r20_) Sheets("Лист1").Range("F" & r10_).Resize(n_).Copy .Range("A" & r20_) Sheets("Лист1").Range("I" & r10_).Resize(n_).Copy .Range("E" & r20_) End With Application.ScreenUpdating = 1 End Sub
[/vba]
Немного по-другому написал [vba]Код
Sub tt() Application.ScreenUpdating = 0 With Sheets("Лист1") r10_ = 20 r11_ = .Range("I" & Rows.Count).End(xlUp).Row If r11_ < r10_ Then Exit Sub Else n_ = r11_ - r10_ + 1 End If End With With Sheets("Лист2") r20_ = 14 r21_ = .Range("E" & Rows.Count).End(xlUp).Row If r21_ >= r20_ Then .Rows(r20_ & ":" & r21_).Delete Else r21_ = r20_ End If .Rows(r20_ & ":" & r20_ + n_ - 1).Insert Sheets("Лист1").Range("C" & r10_).Resize(n_, 2).Copy .Range("B" & r20_) Sheets("Лист1").Range("F" & r10_).Resize(n_).Copy .Range("A" & r20_) Sheets("Лист1").Range("I" & r10_).Resize(n_).Copy .Range("E" & r20_) End With Application.ScreenUpdating = 1 End Sub
[/vba] _Boroda_
К сообщению приложен файл:
123_1.xls
(92.0 Kb)
Скажи мне, кудесник, любимец ба’гов... Платная помощь: Boroda_Excel@mail.ru Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995
Ответить
Сообщение Немного по-другому написал [vba]Код
Sub tt() Application.ScreenUpdating = 0 With Sheets("Лист1") r10_ = 20 r11_ = .Range("I" & Rows.Count).End(xlUp).Row If r11_ < r10_ Then Exit Sub Else n_ = r11_ - r10_ + 1 End If End With With Sheets("Лист2") r20_ = 14 r21_ = .Range("E" & Rows.Count).End(xlUp).Row If r21_ >= r20_ Then .Rows(r20_ & ":" & r21_).Delete Else r21_ = r20_ End If .Rows(r20_ & ":" & r20_ + n_ - 1).Insert Sheets("Лист1").Range("C" & r10_).Resize(n_, 2).Copy .Range("B" & r20_) Sheets("Лист1").Range("F" & r10_).Resize(n_).Copy .Range("A" & r20_) Sheets("Лист1").Range("I" & r10_).Resize(n_).Copy .Range("E" & r20_) End With Application.ScreenUpdating = 1 End Sub
[/vba] Автор - _Boroda_ Дата добавления - 07.11.2016 в 23:06
Nikolay86
Дата: Вторник, 08.11.2016, 21:16 |
Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 55
Репутация:
0
±
Замечаний:
20% ±
Excel 2007
Спасибо _Boroda_ , так тоже работает, даже, наверно, немножко лучше, так как нет зависимости от "бочки п/эт".
Спасибо _Boroda_ , так тоже работает, даже, наверно, немножко лучше, так как нет зависимости от "бочки п/эт". Nikolay86
Ответить
Сообщение Спасибо _Boroda_ , так тоже работает, даже, наверно, немножко лучше, так как нет зависимости от "бочки п/эт". Автор - Nikolay86 Дата добавления - 08.11.2016 в 21:16