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

Вход

Регистрация

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

 

= Мир MS Excel/Копирование определенных столбцов с активной ячейки. - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование определенных столбцов с активной ячейки. (Макросы/Sub)
Копирование определенных столбцов с активной ячейки.
parovoznik Дата: Воскресенье, 10.11.2019, 18:22 | Сообщение № 1
Группа: Проверенные
Ранг: Обитатель
Сообщений: 319
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Добрый вечер.
Имеется таблица Лист "Реестр". Необходимо перенести соответствующие столбцы с активной ячейки на другой Лист "Отчет".
В прилагаемом файле есть описание(результат)
К сообщению приложен файл: 8595841.xlsm(78.0 Kb)
 
Ответить
СообщениеДобрый вечер.
Имеется таблица Лист "Реестр". Необходимо перенести соответствующие столбцы с активной ячейки на другой Лист "Отчет".
В прилагаемом файле есть описание(результат)

Автор - parovoznik
Дата добавления - 10.11.2019 в 18:22
Pelena Дата: Воскресенье, 10.11.2019, 18:46 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 14715
Репутация: 3218 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Здравствуйте.
Так подойдёт?
К сообщению приложен файл: 3218450.xlsm(44.0 Kb)


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Так подойдёт?

Автор - Pelena
Дата добавления - 10.11.2019 в 18:46
Kuzmich Дата: Воскресенье, 10.11.2019, 18:50 | Сообщение № 3
Группа: Проверенные
Ранг: Обитатель
Сообщений: 404
Репутация: 80 ±
Замечаний: 0% ±

Excel 2003
[vba]
Код
Sub CopyActiveCells()

MsgBox "Перенести данные с активной ячейки(соответствующие столбцы)на лист Отчет.", 64, Сообщение
    With Sheets("Отчет")
      LR = .Cells(Rows.Count, 2).End(xlUp).Row + 1
      Cells(ActiveCell.Row, "A").Copy .Cells(LR, "B")
      Cells(ActiveCell.Row, "B").Copy .Cells(LR, "G")
      Cells(ActiveCell.Row, "D").Copy .Cells(LR, "L")
      Cells(ActiveCell.Row, "R").Copy .Cells(LR, "J")
      Cells(ActiveCell.Row, "S").Copy .Cells(LR, "D")
    End With
End Sub
[/vba]
 
Ответить
Сообщение[vba]
Код
Sub CopyActiveCells()

MsgBox "Перенести данные с активной ячейки(соответствующие столбцы)на лист Отчет.", 64, Сообщение
    With Sheets("Отчет")
      LR = .Cells(Rows.Count, 2).End(xlUp).Row + 1
      Cells(ActiveCell.Row, "A").Copy .Cells(LR, "B")
      Cells(ActiveCell.Row, "B").Copy .Cells(LR, "G")
      Cells(ActiveCell.Row, "D").Copy .Cells(LR, "L")
      Cells(ActiveCell.Row, "R").Copy .Cells(LR, "J")
      Cells(ActiveCell.Row, "S").Copy .Cells(LR, "D")
    End With
End Sub
[/vba]

Автор - Kuzmich
Дата добавления - 10.11.2019 в 18:50
parovoznik Дата: Воскресенье, 10.11.2019, 19:21 | Сообщение № 4
Группа: Проверенные
Ранг: Обитатель
Сообщений: 319
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Kuzmich, Pelena благодарю за быстрый ответ. hands
А если Выделить несколько строк например Товар2 и Товар4? Что нужно добавить в коде? :(
 
Ответить
СообщениеKuzmich, Pelena благодарю за быстрый ответ. hands
А если Выделить несколько строк например Товар2 и Товар4? Что нужно добавить в коде? :(

Автор - parovoznik
Дата добавления - 10.11.2019 в 19:21
Pelena Дата: Воскресенье, 10.11.2019, 19:32 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 14715
Репутация: 3218 ±
Замечаний: ±

Excel 2010, 2016 & Mac Excel
Добавить нужно цикл, например, так
[vba]
Код
    With Sheets("Отчет")
        For Each irow In Selection.Rows
            lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            .Cells(lr, 2) = Cells(irow.Row, 1)
            .Cells(lr, 4) = Cells(irow.Row, 19)
            .Cells(lr, 7) = Cells(irow.Row, 2)
            .Cells(lr, 10) = Cells(irow.Row, 18)
            .Cells(lr, 12) = Cells(irow.Row, 4)
        Next irow
    End With
[/vba]


"Черт возьми, Холмс! Но как??!!"
ЯД 41001765434816
 
Ответить
СообщениеДобавить нужно цикл, например, так
[vba]
Код
    With Sheets("Отчет")
        For Each irow In Selection.Rows
            lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            .Cells(lr, 2) = Cells(irow.Row, 1)
            .Cells(lr, 4) = Cells(irow.Row, 19)
            .Cells(lr, 7) = Cells(irow.Row, 2)
            .Cells(lr, 10) = Cells(irow.Row, 18)
            .Cells(lr, 12) = Cells(irow.Row, 4)
        Next irow
    End With
[/vba]

Автор - Pelena
Дата добавления - 10.11.2019 в 19:32
Gustav Дата: Воскресенье, 10.11.2019, 20:16 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1701
Репутация: 687 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Добавить нужно цикл

К циклу - небольшое дополнительное сокращение-извращение :)
[vba]
Код
    With Sheets("Отчет")
        For Each irow In Selection.Rows
            lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            For i = 0 to 4
                .Cells(lr, Array(2, 4, 7, 10, 12)(i)) = Cells(irow.Row, Array(1, 19, 2, 18, 4)(i))
            Next i
        Next irow
    End With
[/vba]


Мой tip box - яд 41001663842605
 
Ответить
Сообщение
Добавить нужно цикл

К циклу - небольшое дополнительное сокращение-извращение :)
[vba]
Код
    With Sheets("Отчет")
        For Each irow In Selection.Rows
            lr = .Cells(Rows.Count, 2).End(xlUp).Row + 1
            For i = 0 to 4
                .Cells(lr, Array(2, 4, 7, 10, 12)(i)) = Cells(irow.Row, Array(1, 19, 2, 18, 4)(i))
            Next i
        Next irow
    End With
[/vba]

Автор - Gustav
Дата добавления - 10.11.2019 в 20:16
parovoznik Дата: Воскресенье, 10.11.2019, 20:30 | Сообщение № 7
Группа: Проверенные
Ранг: Обитатель
Сообщений: 319
Репутация: 18 ±
Замечаний: 0% ±

Excel 2007
Pelena, БЛАГОДАРЮ!!! hands
Gustav, БРАВО. Люблю с извращением. hands


Сообщение отредактировал parovoznik - Воскресенье, 10.11.2019, 20:33
 
Ответить
СообщениеPelena, БЛАГОДАРЮ!!! hands
Gustav, БРАВО. Люблю с извращением. hands

Автор - parovoznik
Дата добавления - 10.11.2019 в 20:30
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование определенных столбцов с активной ячейки. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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