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

Вход

Регистрация

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

 

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

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

Excel 2013
Добрый вечер.
Имеется таблица Лист "Реестр". Необходимо перенести соответствующие столбцы с активной ячейки на другой Лист "Отчет".
В прилагаемом файле есть описание(результат)
К сообщению приложен файл: 8595841.xlsm (78.0 Kb)
 
Ответить
СообщениеДобрый вечер.
Имеется таблица Лист "Реестр". Необходимо перенести соответствующие столбцы с активной ячейки на другой Лист "Отчет".
В прилагаемом файле есть описание(результат)
Автор - parovoznik
Дата добавления - 10.11.2019 в 18:22
Pelena Дата: Воскресенье, 10.11.2019, 18:46 | Сообщение № 2
Группа: Админы
Ранг: Местный житель
Сообщений: 19405
Репутация: 4555 ±
Замечаний: ±

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

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеЗдравствуйте.
Так подойдёт?
Автор - Pelena
Дата добавления - 10.11.2019 в 18:46
Kuzmich Дата: Воскресенье, 10.11.2019, 18:50 | Сообщение № 3
Группа: Проверенные
Ранг: Ветеран
Сообщений: 714
Репутация: 157 ±
Замечаний: 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
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

Excel 2013
Kuzmich, Pelena благодарю за быстрый ответ. hands
А если Выделить несколько строк например Товар2 и Товар4? Что нужно добавить в коде? :(
 
Ответить
СообщениеKuzmich, Pelena благодарю за быстрый ответ. hands
А если Выделить несколько строк например Товар2 и Товар4? Что нужно добавить в коде? :(
Автор - parovoznik
Дата добавления - 10.11.2019 в 19:21
Pelena Дата: Воскресенье, 10.11.2019, 19:32 | Сообщение № 5
Группа: Админы
Ранг: Местный житель
Сообщений: 19405
Репутация: 4555 ±
Замечаний: ±

Excel 365 & 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]

"Черт возьми, Холмс! Но как??!!"
Ю-money 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
Группа: Админы
Ранг: Участник клуба
Сообщений: 2797
Репутация: 1161 ±
Замечаний: ±

начинал с Excel 4.0, видел 2.1
Цитата Pelena, 10.11.2019 в 19:32, в сообщении № 5 ()
Добавить нужно цикл

К циклу - небольшое дополнительное сокращение-извращение :)
[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
 
Ответить
Сообщение
Цитата Pelena, 10.11.2019 в 19:32, в сообщении № 5 ()
Добавить нужно цикл

К циклу - небольшое дополнительное сокращение-извращение :)
[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
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

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


Сообщение отредактировал parovoznik - Воскресенье, 10.11.2019, 20:33
 
Ответить
СообщениеPelena, БЛАГОДАРЮ!!! hands
Gustav, БРАВО. Люблю с извращением. hands
Автор - parovoznik
Дата добавления - 10.11.2019 в 20:30
parovoznik Дата: Вторник, 26.11.2019, 16:59 | Сообщение № 8
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

Excel 2013
Добрый день.
В процессе работы возникли некие вопросы : как сохранить при переносе форматы(шрифт, границы полей) и добавить на лист "Отчет" доп.поля.(Дата отгрузки=СЕГОДНЯ и в Столбец Операция- слово расход. В примере отобразил желаемый результат. Заранее благодарен.
К сообщению приложен файл: Perenos.xlsm (44.5 Kb)
 
Ответить
СообщениеДобрый день.
В процессе работы возникли некие вопросы : как сохранить при переносе форматы(шрифт, границы полей) и добавить на лист "Отчет" доп.поля.(Дата отгрузки=СЕГОДНЯ и в Столбец Операция- слово расход. В примере отобразил желаемый результат. Заранее благодарен.
Автор - parovoznik
Дата добавления - 26.11.2019 в 16:59
Kuzmich Дата: Вторник, 26.11.2019, 18:26 | Сообщение № 9
Группа: Проверенные
Ранг: Ветеран
Сообщений: 714
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
Используйте Специальную вставку PasteSpecial
[vba]
Код
Sub CopyActiveCells()
'    MsgBox "Перенести данные с активной ячейки(соответствующие столбцы)на лист Отчет.", 64, Сообщение
Application.ScreenUpdating = False
    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))
              Cells(irow.Row, Array(1, 19, 2, 18, 4)(i)).Copy
              .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteColumnWidths
              .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteFormats
              .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteValues
            Next i
        Next irow
        .Cells(lr, 1) = Date
        .Cells(lr, 3) = "Расход"
    End With
    Лист2.Activate
Application.ScreenUpdating = True
End Sub
[/vba]
 
Ответить
СообщениеИспользуйте Специальную вставку PasteSpecial
[vba]
Код
Sub CopyActiveCells()
'    MsgBox "Перенести данные с активной ячейки(соответствующие столбцы)на лист Отчет.", 64, Сообщение
Application.ScreenUpdating = False
    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))
              Cells(irow.Row, Array(1, 19, 2, 18, 4)(i)).Copy
              .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteColumnWidths
              .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteFormats
              .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteValues
            Next i
        Next irow
        .Cells(lr, 1) = Date
        .Cells(lr, 3) = "Расход"
    End With
    Лист2.Activate
Application.ScreenUpdating = True
End Sub
[/vba]
Автор - Kuzmich
Дата добавления - 26.11.2019 в 18:26
parovoznik Дата: Вторник, 26.11.2019, 20:15 | Сообщение № 10
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

Excel 2013
Kuzmich, спасибо за код,но я применил и часть данных не переносится!
К сообщению приложен файл: Perenos2.xlsm (43.5 Kb)
 
Ответить
СообщениеKuzmich, спасибо за код,но я применил и часть данных не переносится!
Автор - parovoznik
Дата добавления - 26.11.2019 в 20:15
Kuzmich Дата: Вторник, 26.11.2019, 20:38 | Сообщение № 11
Группа: Проверенные
Ранг: Ветеран
Сообщений: 714
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
Поменяйте в коде эту часть
[vba]
Код
           Next i
             .Cells(lr, 1) = Date
             .Cells(lr, 3) = "Расход"
             .Range(.Cells(lr, 1), .Cells(lr, 12)).Borders.Weight = xlThin
        Next irow
[/vba]
 
Ответить
СообщениеПоменяйте в коде эту часть
[vba]
Код
           Next i
             .Cells(lr, 1) = Date
             .Cells(lr, 3) = "Расход"
             .Range(.Cells(lr, 1), .Cells(lr, 12)).Borders.Weight = xlThin
        Next irow
[/vba]
Автор - Kuzmich
Дата добавления - 26.11.2019 в 20:38
parovoznik Дата: Вторник, 26.11.2019, 21:13 | Сообщение № 12
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

Excel 2013
Kuzmich, подменил. Дата и расход перенеслись ,а остальные строки нет :(
К сообщению приложен файл: Perenos3.xlsm (48.8 Kb)
 
Ответить
СообщениеKuzmich, подменил. Дата и расход перенеслись ,а остальные строки нет :(
Автор - parovoznik
Дата добавления - 26.11.2019 в 21:13
Kuzmich Дата: Вторник, 26.11.2019, 21:46 | Сообщение № 13
Группа: Проверенные
Ранг: Ветеран
Сообщений: 714
Репутация: 157 ±
Замечаний: 0% ±

Excel 2003
По всей видимости вы не выделили ни одной ячейки на листе Реестр
 
Ответить
СообщениеПо всей видимости вы не выделили ни одной ячейки на листе Реестр
Автор - Kuzmich
Дата добавления - 26.11.2019 в 21:46
parovoznik Дата: Вторник, 26.11.2019, 22:15 | Сообщение № 14
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

Excel 2013
Kuzmich, выделял я приложенном файле отметил ,как получилось и как должно быть :(
 
Ответить
СообщениеKuzmich, выделял я приложенном файле отметил ,как получилось и как должно быть :(
Автор - parovoznik
Дата добавления - 26.11.2019 в 22:15
Pelena Дата: Вторник, 26.11.2019, 22:40 | Сообщение № 15
Группа: Админы
Ранг: Местный житель
Сообщений: 19405
Репутация: 4555 ±
Замечаний: ±

Excel 365 & Mac Excel
У меня работает код в файле. Только можно вместо
[vba]
Код
            Cells(irow.Row, Array(1, 19, 2, 18, 4)(i)).Copy
            .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteColumnWidths
            .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteFormats
            .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteValues
[/vba]
оставить
[vba]
Код
Cells(irow.Row, Array(1, 19, 2, 18, 4)(i)).Copy .Cells(lr, Array(2, 4, 7, 10, 12)(i))
[/vba]
ведь столбцы на листе Отчёт уже настроены по ширине

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеУ меня работает код в файле. Только можно вместо
[vba]
Код
            Cells(irow.Row, Array(1, 19, 2, 18, 4)(i)).Copy
            .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteColumnWidths
            .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteFormats
            .Cells(lr, Array(2, 4, 7, 10, 12)(i)).PasteSpecial xlPasteValues
[/vba]
оставить
[vba]
Код
Cells(irow.Row, Array(1, 19, 2, 18, 4)(i)).Copy .Cells(lr, Array(2, 4, 7, 10, 12)(i))
[/vba]
ведь столбцы на листе Отчёт уже настроены по ширине
Автор - Pelena
Дата добавления - 26.11.2019 в 22:40
parovoznik Дата: Среда, 27.11.2019, 00:32 | Сообщение № 16
Группа: Проверенные
Ранг: Обитатель
Сообщений: 443
Репутация: 26 ±
Замечаний: 0% ±

Excel 2013
Pelena, Kuzmich благодарю за ответ.
Pelena, вам особое большое спасибо. hands
 
Ответить
СообщениеPelena, Kuzmich благодарю за ответ.
Pelena, вам особое большое спасибо. hands
Автор - parovoznik
Дата добавления - 27.11.2019 в 00:32
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Копирование определенных столбцов с активной ячейки. (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

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