Страницы: 1
RSS
Поиск и копирование по условию двух ячеек, Поиск по значениям двух ячеек первого листа во втором листе и копирование обеих строк на третий лист
 
Добрый день.
Помогите с макросом.
Лист1 и Лист2 идентичны по формату но разные по данным, но есть совпадения в столбцах А и В. Нужно найти совпадения по условию  и скопировать обе строки на Лист3 друг под другом.
Подробнее: На Лист1 есть столбцы А и В, нужно найти на Лист2 совпадения в столбцах А и В и скопировать эти строки обеих листов друг под другом. Следующую пару совпадения копировать через строчку.
Изменено: Вадим Алекс - 23.02.2020 20:05:17
 
Добрый день!
У вас совпадений гораздо больше чем в примере, не знаю что с этим делать. Думаю дальше сами разберетесь.
 
Спасибо! как раз то что нужно. Остальное доделаю сам.
 
У меня тоже получилось больше совпадений
Код
'запускать при активном листе Лист1
Sub iFind_Copy()
Dim i As Long
Dim iLastRow As Long
Dim iLR As Long
Dim FoundCell As Range
Dim List3 As Worksheet
  Set List3 = ThisWorkbook.Worksheets("Лист3")
   iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
   List3.Cells.Clear
 With Worksheets("Лист2")
  For i = 2 To iLastRow
    Set FoundCell = .Columns(1).Find(Cells(i, "A"), , xlValues, xlWhole)
     If Not FoundCell Is Nothing Then
        If FoundCell.Offset(, 1) = Cells(i, "B") Then
          iLR = List3.Cells(List3.Rows.Count, "A").End(xlUp).Row + 2
          List3.Cells(iLR, "A") = "Лист1"
          Range("A" & i & ":K" & i).Copy List3.Cells(iLR, "B")
          List3.Cells(iLR + 1, "A") = "Лист2"
          .Range("A" & FoundCell.Row & ":K" & FoundCell.Row).Copy List3.Cells(iLR + 1, "B")
        End If
     End If
  Next
 End With
End Sub
Страницы: 1
Наверх