Макрос копирующий данныйе столбца до последней заполенной яч

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Макрос копирующий данныйе столбца до последней заполенной яч (Макросы/Sub)

AranyHunter

Дата: Суббота, 05.12.2015, 16:45 | Сообщение № 1

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

Ранг: Новичок

Сообщений: 19

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

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

Excel 2013

Доброго всем времени суток! Я только пытаюсь разобраться с VBA и столкнулся с очень проблемным вопросом (для меня). Суть вопроса% нужен макрос который копировал данные столбца и переносил их на другой лист, но есть условие: он должен копировать данные до последней ячейки (так как данные будут в последствие добавлять)
к Примеру нужно скопировать с list1 столбец В до последней заполненной строки и вставить данные на list2 и так далее

[vba]

Код

Sub ()
Application.ScreenUpdating = False
Application.CutCopyMode = False
iLastA = Worksheets("List2").Cells(Rows.Count, 1).End(xlUp).Row + 1
iLastB = Worksheets("List2").Cells(Rows.Count, 2).End(xlUp).Row + 1
iLastC = Worksheets("List2").Cells(Rows.Count, 3).End(xlUp).Row + 1

Worksheets("List1").Range("B1:B39").Copy
Worksheets("List2").Range("A" & iLastA).PasteSpecial xlValue
Worksheets("List1").Range("C1:C39").Copy
Worksheets("List2").Range("B" & iLastB).PasteSpecial xlValue
Worksheets("List1").Range("I1:I39").Copy
Worksheets("List2").Range("C" & iLastC).PasteSpecial xlValue
Application.CutCopyMode = True
Application.ScreenUpdating = True
End Sub

[/vba]
[moder]Для оформления кода используйте кнопку #[/moder]

Сообщение отредактировал Pelena - Суббота, 05.12.2015, 17:09

Ответить

wild_pig

Дата: Суббота, 05.12.2015, 18:39 | Сообщение № 2

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

Ранг: Обитатель

Сообщений: 517

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

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

2003, 2013

Для одного диапазона
[vba]

Код

Sub uuu()
    Dim a()
'-----------
    With Sheets("Лист1")
        a = .Range(.Cells(1, 1), .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 1)).Value
    End With
    With Sheets("Лист2")
        .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Resize(UBound(a), 1) = a
    End With
End Sub

[/vba]