Немогу исправить шибку в Макросе

[LinkorA]

Я не слишком шарю в макросах но создал такое чудо:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim w As Object
'On Error Resume Next
Sheets("Лист2").Select
If Range("P2").Value = 1 Then
Sheets("Лист2").Select
Range("L2:M2").Select
Selection.Copy
End If
Dim EmptyCell As Range
Sheets("Лист3").Select
Const StartCell = "B1"
If Len(Range(StartCell)) = 0 Then
Set EmptyCell = Range(StartCell)
Else
Set EmptyCell = Range(StartCell).End(xlDown).Offset (1)
End If
EmptyCell.Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Лист2").Select
Range("P4").Select
ActiveCell.FormulaR1C1 = "Выполнен!"

End Sub

Я выделил ошибку которую он находит...
Я хочу чтобы макрос запускался когда значение в Р2 было 1. А макрос выполнял копирование 2-х ячеек на другой лист в первую свободную ячейку из столбца В2 на листе 3. И немогу понять как исправить ошибку....

[Казанский]

Ошибка возникает потому, что активен Лист3, а диапазон EmptyCell находится на том листе, в модуле которого расположен макрос:

If Len(Range(StartCell)) = 0 Then
Set EmptyCell = Range(StartCell)
Else
Set EmptyCell = Range(StartCell).End(xlDown).Offset (1)
End If

Запомните: в модуле листа свойства Range, Cells, Shapes, Names, Hyperlinks и т.д. без явного указания листа относятся не к активному листу, а к листу, в модуле которого расположен код!

[Казанский]

Наверно, надо, чтобы макрос срабатывал только при ИЗМЕНЕНИИ Р2 на 1?
Иначе он будет срабатывать при любом изменении на листе, если Р2 содержит 1.
Попробуйте:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim EmptyCell As Range

If Intersect(Target, Range("P2")) Is Nothing Then Exit Sub
If Range("P2") <> 1 Then Exit Sub
Set EmptyCell = Sheets("Лист3").Cells(Rows.Count, "B").End(xlUp)
If EmptyCell <> "" Then Set EmptyCell = EmptyCell.Offset(1)
Range("L2:M2").Copy EmptyCell
Application.EnableEvents = False
Range("P4") = "Выполнен!"
Application.EnableEvents = True

End Sub

[LinkorA]

Супер!!! Спасибо тебе Казанский =))
Еще один вопросик, терь он копирует у меня формулы... из листа 2, а мне нада токо значения... как это зделать?

[Казанский]

Пардон. Замени

Range("L2:M2").Copy EmptyCell

на

EmptyCell.Resize(, 2).Value = Range("L2:M2").Value

[LinkorA]

Ураа работает =)) большое спасибо тебе.
Тема больше не актуальна...