VBA数据调取数据重复，不知所措

Private Sub Worksheet_Change(ByVal Target As Range)
Dim a As Integer
Dim b As Integer
b = 2
Do
b = b + 1
If Sheet2.Cells(b, 1) = "" Then
Exit Do
End If
Loop
For a = 4 To 3000
   If Sheet1.Cells(a, 13) = "已术" Then
       Sheet2.Cells(b, 1) = Sheet1.Cells(a, 2)
       Sheet2.Cells(b, 2) = Sheet1.Cells(a, 3)
       Sheet2.Cells(b, 3) = Sheet1.Cells(a, 4)
       Sheet2.Cells(b, 4) = Sheet1.Cells(a, 5)
       Sheet2.Cells(b, 5) = Sheet1.Cells(a, 6)
       Sheet2.Cells(b, 6) = Sheet1.Cells(a, 7)
       Sheet2.Cells(b, 7) = Sheet1.Cells(a, 8)
       Sheet2.Cells(b, 8) = Sheet1.Cells(a, 16)
       Sheet2.Cells(b, 9) = Sheet1.Cells(a, 17)
       b = b + 1
      End If
      Next
End Sub