добавить на третий лист еще одну колонку

[panych]

этот макрос копирует на третий лист не совпадающие строки 2-ого столбца, а надо чтобы он копировал 2 и 3 столбцы, совпадения искал по второму, но копировал 2 и 3. Помогите, пожалуйста!
Sub сортировка()
Dim temp, temph
Dim source_ As Object, target_ As Object, tocopy_ As Object, x As Range
Dim iFirstAddress$, blank_cell As Range
Dim cc As Range

Set source_ = Sheets(2)
Set target_ = Sheets(1)
Set tocopy_ = Sheets(3)

For Each cc In source_.UsedRange.Columns(2).Cells

temp = cc.Value
temph = source_.Cells(cc.Row, 5).Value

If temp <> "" Then
Set x = target_.Columns(2).Find(temp, LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)

If Not x Is Nothing Then

iFirstAddress = x.Address

Do
Set x = target_.Columns(2).FindNext(x)
If target_.Cells(x.Row, 3).Value <> temph Then
Set blank_cell = tocopy_.Cells(tocopy_.Range("a" & Rows.Count).End(xlUp).Row + 1, 1)
source_.Cells(cc.Row, 2).Copy blank_cell
End If
Loop While Not x Is Nothing And x.Address <> iFirstAddress
Else
Set blank_cell = tocopy_.Cells(tocopy_.Range("a" & Rows.Count).End(xlUp).Row + 1, 1)
source_.Cells(cc.Row, 2).Copy blank_cell
blank_cell.Offset(0, 2).Value = "не найдено"
End If
End If
Next
MsgBox "готово!"
End Sub

[Ves67]

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

Sub сортировка()
Dim temp, temph
Dim source_ As Object, target_ As Object, tocopy_ As Object, x As Range
Dim iFirstAddress$
Dim cc As Range
Dim lngEnd_tocopy As Long
Set source_ = Sheets(2)
Set target_ = Sheets(1)
Set tocopy_ = Sheets(3)
lngEnd_tocopy = tocopy_.Range("a" & Rows.Count).End(xlUp).Row
For Each cc In source_.UsedRange.Columns("b").Cells
temp = cc.Value
temph = source_.Range("e" & cc.Row).Value
If temp <> "" Then
Set x = target_.Columns("b").Find(temp, LookIn:=xlValues, lookat:=xlPart, MatchCase:=True)
If Not x Is Nothing Then
iFirstAddress = x.Address
Do
Set x = target_.Columns("b").FindNext(x)
If target_.Range("c" & x.Row).Value <> temph Then
lngEnd_tocopy = lngEnd_tocopy + 1
tocopy_.Range("a" & lngEnd_tocopy) = temp
tocopy_.Range("b" & lngEnd_tocopy) = temph
tocopy_.Range("c" & lngEnd_tocopy) = target_.Range("c" & x.Row).Value
tocopy_.Range("d" & lngEnd_tocopy) = "не найдено"
End If
Loop While x.Address <> iFirstAddress
Else
lngEnd_tocopy = lngEnd_tocopy + 1
tocopy_.Range("a" & lngEnd_tocopy) = temp
tocopy_.Range("c" & lngEnd_tocopy) = "не найдено"
End If
End If
Next
MsgBox "готово!"
End Sub

[panych]

работает неправильно, может подскажите как мой доделать, чтобы копировал вместе со значением 2 столбца, еще и значение 3 столбца той же строки.
мой макрос работает. только мне надо добавить копирование значения из 3 столбца, к той ячейке из 2 столбца которая не совпадает.

[ShAM66]

Попробуйте

source_.Cells(cc.Row, 2).Copy blank_cell

поменять на

source_.Cells(cc.Row, 2).Resize(, 2).Copy blank_cell

ЗЫ: Не проверял, файла-то нету.

[Ves67]

а что неправильно работает?

[panych]

Sham66 Спасибо!!!!!!!! Работает))