Я не уверен, что полностью понимаю, чего вы пытаетесь достичь, но попробуйте это
Option Explicit
Sub runThrough(cbpath As String, bspath As String)
Dim wbSource As Workbook, wsSource As Worksheet
Dim wb As Workbook, ws As Worksheet, wsMatch As Worksheet
Dim iLastRow As Long, iLastRowB As Long, iTargetRow As Long
Dim t0 As Single, count As Long, matches As Long
t0 = Timer
' cash book
Set wbSource = Workbooks.Open(cbpath, False, True) ' no link update, read only
Set wsSource = wbSource.Sheets(1)
iLastRow = wsSource.Range("A" & Rows.count).End(xlUp).Row
' summary
Set wb = Workbooks.Open(bspath)
Set ws = wb.Sheets(1)
iLastRowB = ws.Range("B" & Rows.count).End(xlUp).Row
' copy from cashbook to summary
wsSource.Range("A1:Z" & iLastRow).Copy ws.Range("W1")
wbSource.Close SaveChanges:=False
' create new sheet for matched rows
Set wsMatch = wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.count))
wsMatch.Name = "matched"
' nested loop
Dim i As Long, j As Long
Dim colB As String, colW As String
iTargetRow = 0
For i = 2 To iLastRowB
colB = ws.Cells(i, "B")
For j = 1 To iLastRow
colW = ws.Cells(j, "W")
If colB = colW Then
' do something
iTargetRow = iTargetRow + 1
ws.Rows(j).EntireRow.Copy wsMatch.Cells(iTargetRow + 1, 1)
End If
count = count + 1
Next
Next
' result
MsgBox count & " iterations " & iTargetRow & " rows copied to new sheet " & wsMatch.Name, _
vbInformation, "Completed in " & Int(Timer - t0) & " secs"
End Sub