VBA：如何获取行数据，同时比较工作簿并复制第三个工作簿中的数据
嗨，我试图复制差异，同时比较两个工作簿和过去的第三个工作簿中的差异。 下面的代码正在努力复制第一个差异（行）。 该代码不能用于复制两个工作簿的所有差异（行）。 请build议如何复制所有的差异
Sub findingdiff() Dim FileSys, objFile, myFolder, c As Object Dim wb1, wb2 As Workbook Dim wb3 As ThisWorkbook Set wb3 = ThisWorkbook FolderName = ("C:\Users\ashokkumar.d\Desktop\Test\do\") Set FileSys = CreateObject("Scripting.FileSystemObject") Set myFolder = FileSys.GetFolder(FolderName) 'loop through each file and get date last modified. If largest date then store Filename dteFile = DateSerial(1900, 1, 1) For Each objFile In myFolder.Files If InStr(1, objFile.Name, ".xls") > 0 Then If objFile.DateLastModified > dteFile Then dteFile = objFile.DateLastModified strFilename = objFile.Name End If End If Next objFile 'opening of latest file in the folder Set wb2 = Workbooks.Open(FolderName & Application.PathSeparator & strFilename) Set FileSys = Nothing Set myFolder = Nothing With wb2.Sheets("Sheet1") Sh1LastRow = .Cells(Rows.Count, "C").End(xlUp).Row Set Sh1Range = .Range("C1:C" & Sh1LastRow) End With Set wb1 = Workbooks.Open("C:\Users\ashokkumar.d\Desktop\Test\do\AR_Report_Excel_Version_06042017.xls") With wb1.Sheets("Sheet1") Sh2LastRow = .Cells(Rows.Count, "C").End(xlUp).Row Set Sh2Range = .Range("C2:C" & Sh2LastRow) End With 'compare latest workbook with old workbook For Each cell In Sh1Range Set c = Sh2Range.Find( _ what:=cell, LookIn:=xlValues) If c Is Nothing Then cell.Interior.ColorIndex = 5 cell.Offset(0, 1).Interior.ColorIndex = 5 cell.EntireRow.Copy wb3.Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) End If Next cell 'compare with sheet 1 For Each cell In Sh2Range Set c = Sh1Range.Find( _ what:=cell, LookIn:=xlValues) If c Is Nothing Then cell.Interior.ColorIndex = 4 cell.Offset(0, 1).Interior.ColorIndex = 4 cell.EntireRow.Copy wb3.Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) End If Next cell End Sub 看来你正在将差异粘贴到wb3中的同一行，所以它们只是相互覆盖（假设在列A中没有wb1和wb2的数据）
如果更改lastrow以从列C中查找，然后偏移1，则应该每次都粘贴到新行
With wb2.Sheets("Sheet1") Sh1LastRow = .Cells(Rows.Count, "C").End(xlUp).Row Set Sh1Range = .Range("C1:C" & Sh1LastRow) End With Set wb1 = Workbooks.Open "C:\Users\ashokkumar.d\Desktop\Test\do\AR_Report_Excel_Version_06042017.xls") With wb1.Sheets("Sheet1") Sh2LastRow = .Cells(Rows.Count, "C").End(xlUp).Row Set Sh2Range = .Range("C1:C" & Sh2LastRow) End With 'compare latest workbook with old workbook For Each cell In Sh1Range Set c = Sh2Range.Find( _ what:=cell, LookIn:=xlValues) If c Is Nothing Then cell.Interior.ColorIndex = 5 cell.Offset(0, 1).Interior.ColorIndex = 5 Sh3LastRow = wb3.Sheets("Sheet3").Range("C" & Rows.Count).End(xlUp).Row cell.EntireRow.Copy wb3.Sheets("Sheet3").Range("A" & Sh3LastRow).Offset(1, 0) End If Next cell 'compare with sheet 1 For Each cell In Sh2Range Set c = Sh1Range.Find( _ what:=cell, LookIn:=xlValues) If c Is Nothing Then cell.Interior.ColorIndex = 4 cell.Offset(0, 1).Interior.ColorIndex = 4 Sh3LastRow = wb3.Sheets("Sheet3").Range("C" & Rows.Count).End(xlUp).Row cell.EntireRow.Copy wb3.Sheets("Sheet3").Range("A" & Sh3LastRow).Offset(1, 0) End If
*您也设置sh1Range从第1行开始，但sh2Range从第2行开始。我不确定这是否是故意的，但已经修改从第1行开始
这应该是一个评论，但我没有足够的声誉来创造一个，所以这个必须做的。
当你宣布的时候
Dim wb1, wb2 As Workbook
只有wb2被声明为Workbook ， wb1被声明为Variant 。 要将wb1和wb2声明为Workbook ，请写下：
Dim wb1 As Workbook, wb2 As Workbook
同样如此
Dim FileSys, objFile, myFolder, c As Object
应该是哪个
Dim FileSys As Object, objFile As Object, myFolder As Object, c As Object