Macro to Set Filter and Copy past

Hi All,

I have created a Macro to for below.

A)I have Codes on Sheet 2
B) Source data on Sheet1
C) Set filter in Sheet1, filter the data in sheet1 based on the codes on sheet2, copy data and paste it in Sheet3

However, am facing following problems.

A) Header row is not copied and pasted
B)Initially it has to filter the data for the first code in Sheet2 and paste it in Sheet3 and later it has to set filter for second code and copy past so on.

Could you please check the code and make changes.

Option Explicit

Sub CopyRowsThatHaveTheRightCode()
Dim iSourceRow As Long
Dim iDestinationRow As Long
Dim iCode As Long
Dim varCodes As Variant
Dim booCopyThisRow As Boolean

' Get the pass codes
varCodes = Worksheets("Sheet2").Range("A2").Resize(2, 1)
'Loop through all rows in source sheet

iDestinationRow = 0
For iSourceRow = 1 To 500 ' or however many rows you have
booCopyThisRow = False

For iCode = LBound(varCodes, 1) To UBound(varCodes, 1)
If varCodes(iCode, 1) _
= Worksheets("Sheet1").Range("s:s").Cells(iSourceRow, 1) Then ' Code matches.
booCopyThisRow = True
Exit For
End If
Next iCode

If booCopyThisRow = True Then
' Copy into next available destination row
iDestinationRow = iDestinationRow + 1
Worksheets("Sheet1").Range("A:Z").Cells(iSourceRow, 1).Resize(1, 28).Copy _
Destination:=Worksheets("Sheet3").Range("a1").Cells(iDestinationRow, 1)
End If
Next iSourceRow

End Sub