Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Копирование/вставка диапазона - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование/вставка диапазона (Макросы/Sub)
Копирование/вставка диапазона
Nikolay86 Дата: Среда, 26.10.2016, 17:18 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 48
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Добрый вечер.
Задача: В файле Primer с листа1 необходимо скопировать диапазон ячеек С20:I26 (количество строк будет постоянно меняться и определяться как "последняя заполненая -8") и вставить на лист2 следующим образом: ячейки столбца "С" листа1 вставить в столбец "B" листа2 начиная с ячейки "В14" и до "последней заполненной -12" (в примере это В24), ячейки столбца "D" листа1 в столбец "С" начиная с С14 и до "последней заполненной -12" и т.д. (в примере понятно какие куда вставлять по названию столбцов)
Пояснение: Последние 12 заполненных строк должны оставаться нетронутыми и как бы ползать вниз/вверх по листу в зависимости от количества вставляемых строк.
К сообщению приложен файл: Primer.xls(98Kb)


Сообщение отредактировал 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
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 196
Репутация: 48 ±
Замечаний: 0% ±

Excel 2007
И Вам добрый вечер...
 
Ответить
СообщениеИ Вам добрый вечер...

Автор - sboy
Дата добавления - 26.10.2016 в 17:32
KuklP Дата: Среда, 26.10.2016, 17:59 | Сообщение № 3
Группа: Проверенные
Ранг: Старожил
Сообщений: 1994
Репутация: 435 ±
Замечаний: 0% ±

+5
Тут ТС хоть поздоровался, прежде чем понукать форумчанами. :) Nikolay86, Техзадания, задачи у нас ставят здесь


Ну, с НДС и мы чего-то стoим! kuklp@mail.ru
WM Z206653985942, R334086032478, U238399322728
 
Ответить
Сообщение+5
Тут ТС хоть поздоровался, прежде чем понукать форумчанами. :) Nikolay86, Техзадания, задачи у нас ставят здесь

Автор - KuklP
Дата добавления - 26.10.2016 в 17:59
sboy Дата: Четверг, 27.10.2016, 12:06 | Сообщение № 4
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 196
Репутация: 48 ±
Замечаний: 0% ±

Excel 2007
Тут ТС хоть поздоровался

Не сразу... но исправился
Сообщение отредактировал Nikolay86 - Среда, 26.10.2016, 17:36
 
Ответить
Сообщение
Тут ТС хоть поздоровался

Не сразу... но исправился
Сообщение отредактировал Nikolay86 - Среда, 26.10.2016, 17:36

Автор - sboy
Дата добавления - 27.10.2016 в 12:06
sboy Дата: Четверг, 27.10.2016, 14:30 | Сообщение № 5
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 196
Репутация: 48 ±
Замечаний: 0% ±

Excel 2007
Добрый день.
Если правильно понял задачу, вот совместное решение с макрорекодером
[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]
К сообщению приложен файл: 9646934.xls(98Kb)
 
Ответить
СообщениеДобрый день.
Если правильно понял задачу, вот совместное решение с макрорекодером
[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
Группа: Пользователи
Ранг: Новичок
Сообщений: 48
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
hands Спасибо и доброй ночи), Вы все правильно поняли, все работает как надо, код понятен! Возникла пара вопросов: почему
LookIn:=xlFormulas
, а не xlValues мы же вроде как раз значение ищем? И...
Тут ТС хоть поздоровался
что такое ТС?)

P.S. В моем случае этого конечно не предвидится, но макрос чувствителен к пустым ячейкам в списке материалов
ilr = .Cells(20, 3).End(xlDown).Row
просто интересно как в таком случае корректно скопировать все материалы)
 
Ответить
Сообщениеhands Спасибо и доброй ночи), Вы все правильно поняли, все работает как надо, код понятен! Возникла пара вопросов: почему
LookIn:=xlFormulas
, а не xlValues мы же вроде как раз значение ищем? И...
Тут ТС хоть поздоровался
что такое ТС?)

P.S. В моем случае этого конечно не предвидится, но макрос чувствителен к пустым ячейкам в списке материалов
ilr = .Cells(20, 3).End(xlDown).Row
просто интересно как в таком случае корректно скопировать все материалы)

Автор - Nikolay86
Дата добавления - 27.10.2016 в 21:42
Pelena Дата: Четверг, 27.10.2016, 22:27 | Сообщение № 7
Группа: Модераторы
Ранг: Экселист
Сообщений: 9840
Репутация: 2252 ±
Замечаний: 0% ±

Excel 2010 & Mac Excel 2011


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
Сообщение
что такое ТС?

топикстартер

Автор - Pelena
Дата добавления - 27.10.2016 в 22:27
Nikolay86 Дата: Понедельник, 07.11.2016, 22:26 | Сообщение № 8
Группа: Пользователи
Ранг: Новичок
Сообщений: 48
Репутация: 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]
К сообщению приложен файл: 123.xls(90Kb)


Сообщение отредактировал 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
Группа: Модераторы
Ранг: Экселист
Сообщений: 9347
Репутация: 3922 ±
Замечаний: 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]
К сообщению приложен файл: 123_1.xls(92Kb)


Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
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
Группа: Пользователи
Ранг: Новичок
Сообщений: 48
Репутация: 0 ±
Замечаний: 20% ±

Excel 2007
Спасибо _Boroda_, так тоже работает, даже, наверно, немножко лучше, так как нет зависимости от "бочки п/эт". hands
 
Ответить
СообщениеСпасибо _Boroda_, так тоже работает, даже, наверно, немножко лучше, так как нет зависимости от "бочки п/эт". hands

Автор - Nikolay86
Дата добавления - 08.11.2016 в 21:16
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование/вставка диапазона (Макросы/Sub)
Страница 1 из 11
Поиск:

Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!