Macro required please

  • Thread starter Thread starter Dr Hackenbush
  • Start date Start date
D

Dr Hackenbush

This is a repost as I dont think I made much sense previously. !

Here is a graphic of what I would like to get

http://tinypic.com/r/21jx9gm/6

Doesnt need to delete anything just copy and sort from Sheet1 to Sheet2,
and each time its run add the new records it finds above or below whats
already there.

Thanks for looking and hopefully helping me out !
 
Hi

Not sure how to determine which entries are new, so the macro just copy all
entries marked with "y" each time the macro run.

Try this one:

Sub AAA()
Dim ShA As Worksheet
Dim ShB As Worksheet
Dim DestCell As Range
Dim TargetRng As Range

Application.ScreenUpdating = False
Set ShA = Worksheets("Sheet1")
Set ShB = Worksheets("Sheet2")
Set DestCell = ShB.Range("B2")
'Set DestCell = ShB.Range("A" & Rows.Count).End(xlUp).Offset(1, 0)
Set TargetRng = ShA.Range("F2", ShA.Range("F" & Rows.Count).End(xlUp))

For Each cell In TargetRng
If cell.Value = "y" Then
ShA.Range("A" & cell.Row).Resize(1, 2).Copy DestCell
If cell.Offset(0, 2) = "ch" Then
DestCell.Offset(0, 2) = cell.Offset(0, 1)
Else
DestCell.Offset(0, 3) = cell.Offset(0, 1)
End If
Set DestCell = DestCell.Offset(1, 0)
End If
Next
Application.ScreenUpdating = True
End Sub

Regards,
Per
 
Hi Per

It works perfectly, I had to make one small change which I think was just a
typing error, Set DestCell = ShB.Range("B2") changed B2 to A2,

On Sheet1 "y" will only be new entries as after processing they change to
"done"

Thanks very much for your time Its really appreciated

all the best
Dr H
 
Hi Dr H

Thanks for your reply.

Good you solved my typo error. As only new entries are marked with 'y', you
have to use my second Set DestCell=... statement which is currently
commented out to write new data to first empty line. The statement 'Set
DestCell = ShB.Range("B2") ' can be deleted or commented out.

Best regards,
Per
 
Back
Top