Help to copy and paste based on cell values

[supercrewed]

On the code below, I create worksheets with names based on the ID in column “B”, but now I needto copy, and paste the rows to each of the new sheets, with matching sheetnames, and ID numbers, Thanks in advance for any help,
My workbook is attached in the zip fill, and again thanks...
Dim EmployIDNum As Range, SearchRange As Range
Dim ws As Worksheet

Sub CreateNewSheet()
Set SearchRange = Sheets("Sheet1").Range("B2")
Set SearchRange = Range(SearchRange, SearchRange.End(xlDown))

For Each EmployIDNum In SearchRange

On Error Resume Next
Set ws = Worksheets(EmployIDNum.Value)
If Err.Number = 9 Then
Set ws = Worksheets.Add
ws.Move After:=Worksheets(Sheets.Count)
ws.Name = StrConv(RTrim(Left(EmployIDNum.Value, 31)), vbProperCase)
'*****************************
Worksheets("Sheet1").Activate
Rows(EmployIDNum.Row).Select
EmployIDNum.EntireRow.Copy
Worksheets(EmployIDNum).Activate
EmployIDNum.EntireRow.Paste
'*****************************
With ActiveSheet
.Rows(1).Font
.Bold = True
.Italic = True
End With
Range("A1").Resize(, 13).Value = Array("EMPLOYEE_NUMBER", "EMPLOYEE_NAME", "DEPARTMENT", "DATE", "WORK ORDER NUMBER", "STATUS", "ERROR_CODE", "DISCREPANCY", "CAUSE", "CORRECTIVE ACTION", "QUANTITY", "QUANTITY REJECTED", "REJECTED VALUE")
End If
MsgBox (EmployIDNum)

Next EmployIDNum
End Sub

[supercrewed]

Sorry, the column names were changed, the ID, in column "B", Thanks