Copying certain cell on condition

[JEEP]

Hi all,

I need to copy cells A, C, E, G and P of a record from sheet1 to sheet 2 where the value of column I in the record is DATA WHSE. Then the same for DATA SE and DATA TIP. This needs to be run every day as part of a macro

It is probably easy and im not so good with this.

pls be nice

Thanks

[CatDaddy]

[VBA]Sub alex()
Dim r As Long, r2 As Long, r3 As Long, r4 As Long, lr As Long
Dim cell As Range
ActiveWorkbook.Sheets(1).Activate
lr = Range("I" & Rows.Count).End(xlUp).Row
r2 = 2
r3 = 2
r4 = 2
For Each cell In Range("I2:I" & lr)
r = cell.Row
Select Case cell.Text

Case "DATA WHSE"
Range("A" & r & ",C" & r & ",E" & r & ",G" & r & ",P" & r).Copy _
Destination:=Sheets("DATA WHSE").Range("A" & r2)
r2 = r2 + 1
Case "DATA SE"
Range("A" & r & ",C" & r & ",E" & r & ",G" & r & ",P" & r).Copy _
Destination:=Sheets("DATA SE").Range("A" & r3)
r3 = r3 + 1
Case "DATA TIP"
Range("A" & r & ",C" & r & ",E" & r & ",G" & r & ",P" & r).Copy _
Destination:=Sheets("DATA TIP").Range("A" & r4)
r4 = r4 + 1
End Select
Next cell
End Sub[/VBA]