удаление строки с ячейкой, которая повторяется

[Aneli]

о-ля-ля!!!!! вот это да!!!работает).спасибо Вам огромное!!!!!!

[Aneli]

еще есть одна огромная просьба. возможно ли изменить этот макрос, удалялись но одновременно и сохранялись на лист 3. тобишь с листа 1(базового) выбирались строки, значение ячеек стоблца F = значениям столбца А листа 2, и сохранялись в лист 3. тогда получится что на листе 1-остануются строки, не имеющие дубликатов с листа 2, а на листе 3 будут отображены номера с листа 2 но с полными данными(взятыми с листа1).спасибо. если это не возможно, то возможен ли вариант что с листа 1 они не удаляются а просто выбираются данные на лист 3.

[Dophin]

Sub pp()
Dim i As Long, k As Long
Dim iL As Long, il2 As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Sheets("лист1") 'лист с базой
Set sh2 = Sheets("Лист2") ' лист со списком
Sheets.Add.Name = "result" 'создание нового листа, можно удалить
Set sh3 = Sheets("result") ' куда будут складываться результаты
iL = sh1.Cells(Rows.Count, 1).End(xlUp).Row
il2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To iL
If sh2.Range(sh2.Cells(1, 1), sh2.Cells(il2, 1)).Find(what:=sh1.Cells(i, 6), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
k = k + 1
sh1.Range(sh1.Cells(i, 1), sh1.Cells(i, 17)).Copy sh3.Cells(k, 1)
End If
Next i
End Sub

[Aneli]

по итогам макроса в result складываются строки с листа 1 без дубликатов. я возможно не совсем правильно выразила то что я хотела,но необходимо чтобы в result складывались строки, как раз те , которые удалились. тоесть, то что по результатам первого макроса удалялось с листа 1,чтобы сложилось в лист result.

[Dophin]

Sub pp()
Dim i As Long, k As Long
Dim iL As Long, il2 As Long
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim sh3 As Worksheet
Set sh1 = Sheets("лист1") 'лист с базой
Set sh2 = Sheets("Лист2") ' лист со списком
Set sh3 = Sheets("Лист3") 'лист куда складывать
iL = sh1.Cells(Rows.Count, 1).End(xlUp).Row
il2 = sh2.Cells(Rows.Count, 1).End(xlUp).Row
For i = iL To 1 Step -1
If Not sh2.Range(sh2.Cells(1, 1), sh2.Cells(il2, 1)).Find(what:=sh1.Cells(i, 6), LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then
k = k + 1
sh1.Range(sh1.Cells(i, 1), sh1.Cells(i, 17)).Copy sh3.Cells(k, 1)
sh1.Range(sh1.Cells(i, 1), sh1.Cells(i, 17)).Delete shift:=xlUp
End If
Next i
End Sub

[Aneli]

1000 раз спасибо!!!!!!