Macro to copy portion of row if column 'X' is a certain value

[aolsen3]

Hi there,
I am looking for some help to tweak my existing code a bit as I'm not very familiar with Macros. Here's my code (which is working great) but I'd like to make a small change, I just don't know where to insert it! I'd like to only copy a portion of the row (A-J) to another worksheet instead of the entire row

Sub SearchForProjectTypeCommercial()
Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 8
LSearchRow = 8

'Start copying data to row 8 in Commercial (row counter variable)
LCopyToRow = 8

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column F = "Commercial", copy entire row to Commercial
If Range("F" & CStr(LSearchRow)).Value = "Commercial" Then

'Select row in Project Tracker to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Commercial in next row
Sheets("Commercial").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Project Tracker to continue searching
Sheets("Project Tracker").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

Any input would be greatly appreciated

 

[JLGWhiz]

Change this portion of the code:

'Select row in Project Tracker to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy
'Paste row into Commercial in next row
Sheets("Commercial").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

To this:

Sheets("Project Tracker").Range("A" & LSearchRow & ":J" & LSearchRow).Copy _
Sheets("Commercial").Range("A" & LCopyRow)