VBA to search for project code within column and paste rows that match into different sheet

[clh14_96]

Hi all,

I'm looking to write a VBA macro that basically looks up the project code 123 in column D in a worksheet called "Paste into here" and for every line where the project code 123 matches a row in Column D, it copies and pastes the whole row into a new spreadsheet called "Load File". I've not quite got this right so far so any help would be appreciated 

Sub Load_File()

Dim ProjectField As Range
Dim ProjectCode As String
Dim NewWS As Worksheet
Dim loadWS As Worksheet
Dim ws As Worksheet
Dim PNFound As Boolean
Dim DataWS As Worksheet
Dim LastRow As Long, i As Long
Dim tmpArray() As String
Dim Formulas() As Variant
'~~> This is the relevant sheet
Set loadWS = ThisWorkbook.Sheets("Load File")
With loadWS
Sheets("Load File").Select
'clear output
Cells.Select
Selection.ClearContents

Set DataWS = Worksheets("Paste into here")
Set ProjectField = DataWS.Range("D8", DataWS.Range("D8").End(xlDown))
ProjectCode = "123"

Application.ScreenUpdating = False

'Loop through each project name in column D
If ProjectCode = ProjectField Then
PNFound = True
Else
PNFound = False
End If


If PNFound Then 'if PNFound = True

'copy and paste the record to the relevant worksheet, in the next available row
ProjectCode.Offset(0, -3).Resize(1, 13).Copy Destination:=Worksheets(loadWS).Range("A1").End(xlDown).Offset(1, 0)

Else 'if PNFound = False

MsgBox "No bookings for Lulea Programme found", vbInformation

End If

Next

'autofit columns in each sheet in the workbook

For Each ws In ThisWorkbook.Worksheets

ws.UsedRange.Columns.AutoFit

Next ws

Application.ScreenUpdating = True

End Sub

[#2 · Accepted solution]

@clh14_96 

Try this:

Sub Load_File()
    Dim LoadWS As Worksheet
    Dim DataWS As Worksheet
    Dim ProjectField As Range
    Application.ScreenUpdating = False
    Set LoadWS = Worksheets("Load File")
    LoadWS.Cells.ClearContents
    Set DataWS = Worksheets("Paste into here")
    Set ProjectField = DataWS.Range("D8", DataWS.Range("D8").End(xlDown))
    ProjectField.AutoFilter Field:=1, Criteria1:="123"
    ProjectField.EntireRow.Copy Destination:=LoadWS.Range("A1")
    ProjectField.AutoFilter
    Application.ScreenUpdating = True
End Sub