Перенос данных из одного листа на другой

[a.alexandr05]

Огромная просьба помочь!!!
Задача: Нужно при нажатии кнопки скопировать данные из столбца А отмеченные "галочкой" -это столбец С листа1, в столбец А листа 2. При этом вставляемые данные на листе2 не должны стирать уже имеющиеся (т.е должны вставляться ниже). Если копируемое значение уже есть на листе2 в столбце А оно не должно переноситься.
Остальные значения я смогу скопировать с помощью ВПР.

Подобная тема уже была на вашем форуме , но там данные стираются при переносе новых.

[IgorGO]

выполняется с лист1:

Sub Copy12()
  Dim r1 As Long, r2 As Long
  With Worksheets("Ëèñò2")
    r1 = Cells(Rows.Count, 1).End(xlUp).Row - 1
    r2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(2, 1).Resize(r1, 12).Copy Destination:=.Cells(r2, 1)
    .Cells(r2, 3).Resize(r1 - 1, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .[a1].Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 12).RemoveDuplicates Columns:=1, Header:=xlYes
    .Columns(3).ClearContents
  End With
End Sub

[a.alexandr05]

Спасибо большое за быстрый ответ! Но есть проблема: при выполнении макроса, независимо от того отмечена ли последняя строка в таблице на листе1 она все равно копируется на лист2. Может я что неправильно сделал.

И ещё один вопрос. Вы сделали, так что бы этот макрос копировал все столбцы в отмеченной строке, но мне необходимы не все столбцы с листа 1 на листе 2. Каждый раз удалять не нужные столбцы не очень удобно.
Возможно ли в макросе указать определенные столбцы и как это можно сделать? Либо сделать так, что бы копировался только столбец А.

[IgorGO]

с последней строкой - случилась ошибка...
копируется только колонка А:

Sub Copy12()
 Dim r1 As Long, r2 As Long
  With Worksheets("Ëèñò2")
    r1 = Cells(Rows.Count, 1).End(xlUp).Row - 1
    r2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
    Cells(2, 1).Resize(r1, 3).Copy Destination:=.Cells(r2, 1)
    .Cells(r2, 3).Resize(r1, 1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .[a1].Resize(.Cells(Rows.Count, 1).End(xlUp).Row, 12).RemoveDuplicates Columns:=1, Header:=xlYes
    .Cells(r2, 2).Resize(r1, 2).ClearContents
  End With
End Sub

[a.alexandr05]

Может я что делаю не так, поставил ваш макрос, копирует только столбец А (это все хорошо), но копирует только в пределах 15 строк, если продолжить дальше таблицу ничего не копирует.

[DiemonStar]

попробуйте так:

Sub Copy12()
 Dim R1 As Range, R2 As Range
  With Worksheets("Ëèñò2")
    Set R1 = Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeConstants).EntireRow
    Set R2 = .Range("A" & .Cells(Rows.Count, 1).End(xlUp).Row + 1).EntireRow
    Intersect(R1, [A:B]).Copy R2.Cells(1, 1)
    Set R2 = R2.Resize(R1.Rows.Count)
    .[a1].Resize(.Cells(Rows.Count, 1).End(xlUp).Row).EntireRow.RemoveDuplicates Columns:=1, Header:=xlYes
    Intersect(R1, [C:C]).ClearContents
  End With
End Sub

[a.alexandr05]

Спасибо!!!! Всё работает!