VBA to copy row but only those cells in certain columns

clh_1496 

Try this:

Sub CopyCells()
    Dim PBS As Worksheet
    Dim CHECK As Worksheet
    Dim Cell As Range
    Dim Addr As String
    Dim Target As Range
    Application.ScreenUpdating = False
    Set PBS = Worksheets("PBS")
    Set CHECK = Worksheets("CHECK")
    Set Target = CHECK.Range("A" & CHECK.Rows.Count).End(xlUp)
    Set Cell = PBS.Range("E:E").Find(What:="CHECK", LookAt:=xlWhole)
    If Not Cell Is Nothing Then
        Addr = Cell.Address
        Do
            Set Target = Target.Offset(1)
            Target.Resize(1, 3).Value = Array( _
                Cell.Offset(0, -4).Value, _
                Cell.Offset(0, -2).Value, _
                Cell.Offset(0, -1).Value)
            Set Cell = PBS.Range("E:E").Find(What:="CHECK", After:=Cell, LookAt:=xlWhole)
            If Cell Is Nothing Then Exit Sub
        Loop Until Cell.Address = Addr
    End If
    Application.ScreenUpdating = True
End Sub