根据A列中匹配的单元格值复制和粘贴特定的列数据

Question

我必须根据标题和匹配ID将特定列数据从Sheet1复制到Sheet2。预期的宏必须循环遍历A列（Sheet1），匹配A列（Sheet2）中的ID，并将特定列数据与Sheet1中的标题匹配并粘贴到Sheet2中具有标题的相同位置。

表1和表2中的数据如下所示。我想为Sheet2中的每个ID复制Location，StartDate和EndDate。

SHEET1

Col A
BadgeID    Location    StartDate     EndDate
1111       AA1199      01/17/2016    03/17/2016
2222       BB2266      02/12/2016    05/25/2016
3333       CC5577      07/12/2016    09/15/2016

SHEET2

Col A
BadgeID    Location    StartDate     EndDate
1111       
2222
3333       

我已经使用以下代码根据预定义的匹配单元格值复制并粘贴整行，但是对于此练习，ID超过5000.任何帮助都将非常感谢。

Option Compare Text
Public Sub CompareandCopy()
Dim strFind As String
Dim i As Long, j As Long
Dim wsFind As Worksheet
Dim wsPaste As Worksheet

strFind = InputBox("Enter ID Here")
Set wsFind = Sheets("Sheet1")
Set wsPaste = Sheets("Sheet2")

j = 2

Worksheets("Sheet2").Range("A3:C10").ClearContents
For i = 2 To wsFind.UsedRange.Rows.Count
    If wsFind.Range("A" & i) = strFind Then
        wsFind.Range(i & ":" & i).Copy Destination:=wsPaste.Range(j & ":" & j)
        j = j + 1
    End If
Next i

Worksheets("Sheet2").Select
End Sub

由于