vba校对不同工作薄中的内容

Option Explicit

Sub Find()
Dim myWorkbook As Workbook
Dim ws As Worksheet
Dim rg As Range, rg2 As Range
Dim rgFirst As Range
Dim nLength As Integer, i As Integer
Dim strTmp As String
Dim strFilePath As String '第三方2文件夹中导入xml文件名
Dim nNum As Integer  '销售件数
'nLength = 0
strTmp = ""
On Error GoTo errEx

Set rgFirst = Cells(ActiveCell.Row, ActiveCell.Column)

Do While rgFirst.Value <> ""  '*************循环**********************************

nLength = 0
strTmp = rgFirst.Value

If Right(strTmp, 1) > 9 Then
    MsgBox (strTmp & "的发货单据号有误！")
    Exit Sub
End If

Set ws = ThisWorkbook.Sheets(3)
ws.Columns("A:A").NumberFormatLocal = "yyyy-m-d"
ws.Columns("H:H").NumberFormatLocal = "yyyy-m-d"
Set rg2 = ws.Cells(rgFirst.Row, 1)
rg2 = rgFirst.Offset(0, -1)
rg2.Offset(0, 1) = rgFirst.Offset(0, -4)
rg2.Offset(0, 4) = rgFirst.Offset(0, 7)
'rg2.Offset(0, 7) = rgFirst.Offset(0, 1)
'rg2.Offset(0, 8) = rgFirst.Offset(0, 0)
'rg2.Offset(0, 9) = rgFirst.Offset(0, -2)


'strFilePath = ThisWorkbook.Path & "/四川科伦每天销售发货明细.xls"
nNum = rgFirst.Offset(0, 2)

Set myWorkbook = Workbooks.Item("四川科伦每天销售发货明细.xls")
'Set myWorkbook = ActiveWorkbook

For i = 2 To myWorkbook.Sheets.Count '''''''''''

Set ws = myWorkbook.Worksheets(i)
Set rg = ws.Cells(1, 2)
Do While rg.Row <> ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1 + 1
   If rg.Value = rgFirst.Value Then
        rg2.Offset(0, 7) = rg.Offset(0, -1)
        rg2.Offset(0, 8) = rg.Offset(0, 0)
        rg2.Offset(0, 9) = rg.Offset(0, 2)
        If nNum <> rg.Offset(0, 4).Value Then
            MsgBox strTmp & "的件数" & rg.Offset(0, 4).Value & "不对！可能错误！"
            rg2.EntireRow.Interior.Color = 65535
            rg2.Offset(0, 3) = rg.Offset(0, 4).Value
            rg2.Offset(0, 3).Font.Color = -16776961
            Exit Sub
        Else
            rg2.Offset(0, 3) = nNum
        End If
        Exit For
    End If
    Set rg = rg.Offset(1, 0)
Loop

Next ''''''''''''''''''''''''''

  If rg.Row = ws.UsedRange.Rows.Count + ws.UsedRange.Row Then
    MsgBox strTmp & "销售单不对！可能错误！"
     rg2.EntireRow.Interior.Color = 65535
     Exit Sub
  End If

  Set rgFirst = rgFirst.Offset(1, 0)
  rgFirst.Select
  
Loop          ' *************循环**********************************

  Exit Sub
errEx:
 MsgBox (strTmp & "的执行有错误，请检查！")
End Sub

Sub Macro1()
Application.OnKey "^+g", "Find"
End Sub