Copying specific data to another sheet based on cell value

[JJabra]

Hi guys,

What I am looking to do is copy data from one sheet to another, however I only want it to copy columns A and B based on the cell value of Column E in each row

So far I have the following code which is able to copy the data, but currently pastes it on every column on the worksheet and I can't see why. Apologies if it is something simple, I am relatively new to VBA.

Sub HoldCodeSeparation()


Dim Source As Worksheet
Dim Target As Worksheet




Set Source = ActiveWorkbook.Worksheets("Hold Codes")
Set Target = ActiveWorkbook.Worksheets("Extract")


j = 2 ' Start copying to row 1 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If CStr(c) = "22" Then
Source.Range(Cells(c.Row, 1), Cells(c.Row, 2)).Copy Target.Rows(j)
j = j + 1
End If
Next c


End Sub

 

[JJabra]

This is perfect! Thanks once again

 

[Fluff]

You're welcome & thanks for the feedback

 

[Juddman79]

I think this is similar to what I'm trying to achieve with 2 sheets.

I have two sheets (tracker - sheet 1 and sessions - sheet 2) and I would like to copy Columns B, C, G from sheet 1 to Columns A, B, C respectively in sheet 2 once the cell data is filled in sheet 1 and the location in Column a is equal to Aberdeen. I don't specifically need the location to copy over to sheet 2 but if that makes things a bit simpler then its not an issue. The data would need to go to the next available free row in sheet 2

Sheet 1
Column A - Location
Column B - Surname
Column C - First Name
Column G - Worker

Sheet 2
Column A - Surname
Column B - First Name
Column C - Worker

In sheet 1 I have the following code already running to sort the data if this makes a difference to the above request:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Range("A:A, F:F")) Is Nothing Then
    If Target.CountLarge > 1 Then Exit Sub
    If Range("A" & Target.Row) <> "" And Range("F" & Target.Row) <> "" Then
      Range("A2:X101" & Range("A" & Rows.Count).End(3).Row).Sort _
        key1:=Range("A2"), order1:=xlAscending, key2:=Range("F2"), order2:=xlAscending, Header:=xlYes
    End If
  End If
End Sub

Many thanks in advance if you are able to assist.

 

[Fluff]

Please start a thread of your own, rather than posting to an old thread.
Thanks

 

[Juddman79]

Please start a thread of your own, rather than posting to an old thread.
Thanks

Sorry, no problem at all.