Сравнить листы для копирования отличий

Question

У меня есть этот рабочий код VBA, который сравнивает 2 листа и копии копий на листе «Изменения». Мне нужно сделать наоборот. Мне нужно скопировать различия в лист изменений.

Sub CompareSheets() 
Dim Sht1Rng As Range 
Dim Sht2Rng As Range 

Set Sht1Rng = Worksheets("RXCP Order").Range("A1", Worksheets("RXCP Order").Range("A1000").End(xlUp)) 
Set Sht2Rng = Worksheets("QS1 Order").Range("A1", Worksheets("QS1 Order").Range("A1000").End(xlUp)) 

For Each c In Sht1Rng 
    Set d = Sht2Rng.Find(c.Value, LookIn:=xlValues) 
    If Not d Is Nothing Then 
     Worksheets("Changes").Range("A1000").End(xlUp).Offset(1, 0).Value = c.Value 
     Worksheets("Changes").Range("A1000").End(xlUp).Offset(0, 1).Value = c.Offset(0, 1).Value 
     Set d = Nothing 
    End If 
Next c 
End Sub 

Answer 1

Один из способов найти изменения от одного листа к другому, чтобы добавить Лист3 по следующей формуле в каждой ячейке используемого диапазона sheet1:

=if(Sheet1!A1<>Sheet2!A1,1,0) 

Затем добавить столбец Лист3 добавления по ряд. Любые строки с числом больше нуля должны быть скопированы. можно фильтровать затем копировать вставить вручную или запустить свой цикл вниз по столбцу графа в листе три и скопировать строку из листа два на основании ряда он находится на в листе 3

dim aCell as range 
with thisworkbook 
for each acell in .sheets("Sheet3").Range("Z1:Z1000") 
    if acell.value > 0 then 
    .sheets("Sheet1").range("A" & acell.row).entirerow.copy _ 
    .sheets("Sheet4").range("A" & .sheets("Sheet4").usedrange.rows.count + 1) 
    end if 
next acell 
end with 

Вы можете написать макрос скопируйте приведенную выше формулу ко всем ячейкам используемого диапазона листа 3 и скопируйте формулу и в следующий доступный столбец.