Help with VBA - If Column is X , Select Row, Copy Cells and Paste on new sheet

[gr1226]

Help please! After browsing this thread and and others I have achieved to use this code to copy and past data dependent on a specific value in a column. I have 2 issues..

1. After the row is found I would like to copy certain cells of that row such as A C and F
2. I would like to then paste to sheet 2 in cells X, Y, Z

Sub Test ()

Dim xRg As Range
Dim xCell As Range
Dim i As Long
Dim J As Long
Dim K As Long
i = Worksheets("Data").UsedRange.Rows.count
J = Worksheets("Sheet2").UsedRange.Rows.count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Data").Range("Y2:Y" & i)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.count
If CStr(xRg(K).Value) = "1" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
End Sub

Thanks in advance

 

[Fluff]

Hi & welcome to MrExcel
How about

Sub Test()

   Dim xRg As Range
   Dim xCell As Range
   Dim i As Long
   Dim J As Long
   Dim K As Long
   i = Worksheets("Pcode").UsedRange.Rows.Count
   J = Worksheets("data").UsedRange.Rows.Count
   If J = 1 Then
      If Application.WorksheetFunction.CountA(Worksheets("data").UsedRange) = 0 Then J = 0
   End If
   Set xRg = Worksheets("pcode").Range("Y2:Y" & i)
   On Error Resume Next
   Application.ScreenUpdating = False
   For K = 1 To xRg.Count
      If CStr(xRg(K).Value) = "1" Then
      Intersect(xRg(K).EntireRow, Worksheets("pcode").Range("A:A,C:C,F:F")).Copy Destination:=Worksheets("data").Range("X" & J + 1)
      J = J + 1
      End If
   Next
   Application.ScreenUpdating = True
End Sub