comparer les différences de lignes entre deux classurs

J'ai l'printing de comparer les lignes entre deux classurs. Je voudrais comparer les lignes dans deux classurs et append datatables mises à jour du classur principal aux lignes vierges suivantes dans un autre classur. Cependant, mon code ne conserve que la copy de toutes les lignes au lieu de seulement les nouvelles lignes.

Sub test() Dim varSheetA As Variant Dim varSheetB As Variant Dim strRangeToCheck As Ssortingng Dim strRangeToC As Ssortingng Dim iRow As Long Dim iRow2 As Long Dim iCol As Long Dim wbkA As Workbook Dim eRow As Long Dim cfind As Range Dim c As Range Dim rng As Range Dim i, j, k As Integer Dim newarr As Ssortingng Dim existarr As Ssortingng Dim b As Boolean Set wbkA = Workbooks.Open(Filename:="C:\Users\mandy\Desktop\fortest.xlsx") strRangeToCheck = "A:C" strRangeToC = "C:E" varSheetA = wbkA.Worksheets("Sheet1").Range(strRangeToCheck) varSheetB = ThisWorkbook.Worksheets("Sheet1").Range(strRangeToC) For iRow = LBound(varSheetA, 1) To UBound(varSheetA, 1) For iRow2 = LBound(varSheetB, 1) To UBound(varSheetB, 1) For iCol = LBound(varSheetA, 2) To UBound(varSheetA, 2) If ThisWorkbook.Sheets("Sheet1").Range("C").Value = wbkA.Sheets("Sheet1").Range("A") Then If ThisWorkbook.Sheets("Sheet1").Range("D").Value = wbkA.Sheets("Sheet1").Range("B") Then If ThisWorkbook.Sheets("Sheet1").Range("E").Value = wbkA.Sheets("Sheet1").Range("C") Then If varSheetA(iRow, iCol).EntireRow = varSheetB(iRow, iCol).EntireRow Then ' Cells are identical. ' Do nothing Else If ThisWorkbook.Sheets("Sheet1").Range("C" & iRow2).Value = wbkA.Sheets("Sheet1").Range("A" & iRow).Value Then b = False Else If ThisWorkbook.Sheets("Sheet1").Range("D" & iRow2).Value = wbkA.Sheets("Sheet1").Range("B" & iRow).Value Then b = False Else If ThisWorkbook.Sheets("Sheet1").Range("E" & iRow2).Value = wbkA.Sheets("Sheet1").Range("C" & iRow).Value Then b = False Else eRow = ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 3).End(xlUp).Row + 1 ThisWorkbook.Sheets("Sheet1").Range("C" & eRow & ":E" & eRow).EntireRow = wbkA.Sheets("Sheet1").Range("A" & iRow & ":C" & iRow).EntireRow Exit For End If End If End If End If End If End If End If Next Next Next wbkA.Close savechanges:=False End Sub 

entrez la description de l'image ici

• Comparaison des valeurs de date et d'heure sockets à partir de la fonction Now ()
• Rédaction d'arguments de script passés à un file Excel
• Comment importer correctement des colonnes excel qui ont un text enveloppé activé à l'aide de Microsoft.ACE.OLEDB et SqlBulkCopy
• URL d'une feuille spécifique pour une export Excel "Enregistrer une page Web"
• Marco – Une fois le calcul terminé, je souhaite coller les valeurs dans les lignes calculées, mais conserver les formules dans les lignes ci-dessous

 Sub test() Dim WbA As Workbook Set WbA = ActiveWorkbook Dim WbB As Workbook Set WbB = Workbooks.Open(Filename:="C:\Users\mandy\Desktop\fortest.xlsx") Dim SheetA As Worksheet Dim SheetB As Worksheet SheetA = WbA.Sheets("Sheet1") SheetB = WbB.Sheets("Sheet1") Dim eRowA As Integer Dim eRowB As Integer eRowA = (SheetA.Cells(SheetA.Rows.Count, 1).End(xlUp).Row) 'Last line with data in Workbook A (ActiveWorkbook) eRowB = (SheetB.Cells(SheetB.Rows.Count, 1).End(xlUp).Row) 'Last line with data in Workbook B (Opened Workbook) Dim RowA As Integer Dim RowB As Integer For RowA = 1 To eRowA For RowB = 1 To eRowB If SheetA.Rows(RowA) = SheetB.Rows(RowB) Then 'Do nothing Else SheetB.Rows(RowB).Copy SheetA.Rows(eRowA + 1).Paste End If Next RowB Next RowA WbB.Close (False) End Sub