Сравнение двух рабочих тетрадей по 80 листов в каждой

Question

Я пытаюсь написать сценарий, который будет сравнивать две рабочие книги, каждая из которых имеет 80 листов.Имена листов будут совпадать в обеих книгах (одна рабочая книга является копией prod, другая - из среды UAT. Все данные должны быть одинаковыми).Мне удалось запустить скрипт, который будет сравнивать указанный мной лист, но у меня возникли трудности при попытке выяснить, как написать его для сравнения каждого листа.

Sub CompareWorksheets()

Dim varSheetA As Worksheet
Dim varSheetB As Worksheet
Dim varSheetAr As Variant
Dim varSheetBr As Variant
Dim strRangeToCheck As String
Dim iRow As Long
Dim iCol As Long
Dim wbkc As Workbook


Set wbkc = ThisWorkbook  'this is where results of comparison will be documented
Set wbka = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx")  'PROD
Set wbkb = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT

            Set varSheetA = wbka.Worksheets("Members")
            Set varSheetB = wbkb.Worksheets("Members")
            strRangeToCheck = ("A5:A10")

            varSheetAr = varSheetA.Range(strRangeToCheck).Value
            varSheetBr = varSheetB.Range(strRangeToCheck).Value

   erow = 6 'starting row to document summary results

    For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
    For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)

            If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) Then
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
            Else
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22

                wbkc.Activate
                    erow = erow + 1
                        wbkc.Sheets("Summary").Cells(erow, 2) = iRow
                        wbkc.Sheets("Summary").Cells(erow, 3) = iCol
                        wbkc.Sheets("Summary").Cells(erow, 4) = varSheetA.Cells(iRow, iCol)
                        wbkc.Sheets("Summary").Cells(erow, 5) = varSheetB.Cells(iRow, iCol)

            End If
        Next
    Next
End Sub

Answer 1

Start with
  Option Explicit  ' to force you to declare for each variable

Add code to delete prior errors
  Dim wbkc As Workbook, LastRow as Long, nRow as Long
  wbkc.Sheets("Summary").UsedRange 'Refresh UsedRange
  LastRow = wbkc.Sheets("Summary").UsedRange.Rows(wbkc.Sheets("Summary").UsedRange.Rows.Count).Row
  For nRow = LastRow to eRow + 1 step -1
    wbkc.Sheets("Summary").Rows(nRow).Delete
  Next nRow

Basically, google "excel vba for each sheet" and look at the first one 
  https://stackoverflow.com/questions/21918166/excel-vba-for-each-worksheet-loop
to get the driving code (ignoring resizingColumns) and create CompareCells. 

  Sub forEachWs()
    Dim ws As Worksheet
    For Each ws In ActiveWorkbook.Worksheets
        Call CompareCells(ws)
    Next
  End Sub
  Sub CompareCells(ws as Worksheet)
  End Sub

Finally, Add your code inside of CompareCells
Giving  (PLEASE test this code, since we do not have wbka or wbkb excel files)


Option Explicit  ' to force you to declare for each variable

' define output -- this is where results of comparison will be documented
Dim wbkc As Workbook, eRow as long, LastRow as Long, nRow as Long
Set wbkc = ThisWorkbook  
eRow = 6 'starting row to document summary results
wbkc.Sheets("Summary").UsedRange 'Refresh UsedRange
LastRow = wbkc.Sheets("Summary").UsedRange.Rows(wbkc.Sheets("Summary").UsedRange.Rows.Count).Row
For nRow = LastRow to eRow + 1 step -1
    wbkc.Sheets("Summary").Rows(nRow).Delete  ' delete prior errors
Next nRow


' define inputs -- 
Dim wbka As Workbook, wbkb As Workbook
Set wbka = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx")  'PROD
Set wbkb = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx") 'UAT

' step thru each sheet
Dim ws As Worksheet
For Each ws In wbka.Worksheets
    '
    Dim varSheetA As Worksheet, varSheetB As Worksheet
    Dim varSheetAr As Variant, varSheetBr As Variant
    Dim strRangeToCheck As String

    Set varSheetA = wbka.Worksheets(ws.Name)
    Set varSheetB = wbkb.Worksheets(ws.Name)
    strRangeToCheck = ("A5:A10")

    varSheetAr = varSheetA.Range(strRangeToCheck).Value
    varSheetBr = varSheetB.Range(strRangeToCheck).Value

    ' step thru each cell
    Dim iRow As Long, iCol As Long
    For iRow = LBound(varSheetAr, 1) To UBound(varSheetAr, 1)
    For iCol = LBound(varSheetAr, 2) To UBound(varSheetAr, 2)

            If varSheetAr(iRow, iCol) = varSheetBr(iRow, iCol) Then
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = xlNone
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = xlNone
            Else
              varSheetA.Cells(iRow, iCol).Interior.ColorIndex = 22
              varSheetB.Cells(iRow, iCol).Interior.ColorIndex = 22

                wbkc.Activate
                    erow = erow + 1

                        wbkc.Sheets("Summary").Cells(erow, 1) = ws.Name  'ADDed
                        wbkc.Sheets("Summary").Cells(erow, 2) = iRow
                        wbkc.Sheets("Summary").Cells(erow, 3) = iCol
                        wbkc.Sheets("Summary").Cells(erow, 4) = varSheetA.Cells(iRow, iCol)
                        wbkc.Sheets("Summary").Cells(erow, 5) = varSheetB.Cells(iRow, iCol)

            End If
        Next iCol
    Next iRow


Next ws

Answer 2

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

Sub CompareWorksheets()

    Dim wbPROD As Workbook, wbUAT As Workbook, wbSummary As Workbook
    Dim wsPROD As Worksheet, wsUAT As Worksheet, wsSummary As Worksheet
    Dim arrPROD As Variant, arrUAT As Variant
    Dim strRangeToCheck As String
    Dim iRow As Long, iCol As Long

    Set wbSummary = ThisWorkbook                      'this is where results of comparison will be documented
    Set wsSummary = wbkc.Sheets("Summary")
    Set wbPROD = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard1.xlsx")    'PROD
    Set wbUAT = Workbooks.Open(Filename:="C:\Users\Desktop\dashboard2.xlsx")    'UAT

    strRangeToCheck = ("A5:A10")

    erow = 6                                          'starting row to document summary results

    For Each wsPROD In wbPROD.Worksheets
        Set wsUAT = wbUAT.Worksheets(wsPROD.Name)
        arrPROD = wsPROD.Range(strRangeToCheck).Value
        arrUAT = wsUAT.Range(strRangeToCheck).Value

        For iRow = LBound(arrPROD, 1) To UBound(arrPROD, 1)
            For iCol = LBound(arrPROD, 2) To UBound(arrPROD, 2)

                If arrPROD(iRow, iCol) = arrUAT(iRow, iCol) Then
                    wsPROD.Cells(iRow, iCol).Interior.ColorIndex = xlNone
                    wsUAT.Cells(iRow, iCol).Interior.ColorIndex = xlNone
                Else
                    wsPROD.Cells(iRow, iCol).Interior.ColorIndex = 22
                    wsUAT.Cells(iRow, iCol).Interior.ColorIndex = 22

                    wbkc.Activate
                    erow = erow + 1
                    With wsSummary
                        .Cells(erow, 2) = iRow
                        .Cells(erow, 3) = iCol
                        .Cells(erow, 4) = wsPROD.Cells(iRow, iCol)
                        .Cells(erow, 5) = wsUAT.Cells(iRow, iCol)
                    End With
                End If
            Next
        Next
    Next

End Sub