Sub CopyData()
Dim FindString As String
Dim i As Integer, iCount As Integer
Dim FRange As Range
Dim FoundCount As Integer, EndRow As Integer
'清除Sheet5中的数据
If Sheet5.Range("A65536").End(xlUp).Row > 2 Then Sheet5.Range("A2:N65536").Clear
'查找数据并将数据复制到Sheet5中
iCount = Sheet2.Range("B65536").End(xlUp).Row
FoundCount = 0
For i = 2 To iCount
FindString = Sheet2.Cells(i, 2).Value
Set FRange = Sheet1.Cells.Find(FindString, [A1], , , xlByRows, xlNext)
If Not FRange Is Nothing Then
FoundCount = FoundCount + 1
EndRow = Sheet5.Range("A65536").End(xlUp).Row + 1
Sheet1.Range("A" & FRange.Row & ":N" & FRange.Row).Copy Destination:=Sheet5.Cells(EndRow, 2)
Sheet5.Cells(EndRow, 1).Value = FoundCount
End If
Next i