Help Please Cutting and pasting based on cell value

Help please, I am trying to automate the cutting and pasting of lines
based on a value of a cell.

I have a spreadsheet that is partly automated that sorts contact data and

will copy a selected range into a new spreadsheet. What I want to try to
do is select rows within this that have a status = good and paste them
only to my template spreadsheet.

I have worked out how to automate the file saving with a date and
timestamp but not how to make the selection and invoke a message box to
confirm the the selection.

Layout is :

Date/Name/Company/Address/Product/Status/Ship/Product/Qty/ +5 columns
with Sales Data

My template just needs the first nine columns for an import process and
the rest are disregarded.

Any help at all would be grately appreciated


Many thanks


Mike

So you want the code to go down some column and when it sees the word
"good" to cut that row, and paste it onto the template sheet? If so,
what column are goods in?

Bob. I have a similar dilema trying to automate a simple operation. My lists to match can be 700 part numbers to a master list with location of appx 4000 I have been deleting too many lines manually. If you get an answer to your dilema it might also work for me. I am new here so I will try to keep watching the posts

Good luck!! Don Delaney [email protected]

In article <[email protected]>,
[email protected] says...
> So you want the code to go down some column and when it sees the word
> "good" to cut that row, and paste it onto the template sheet? If so,
> what column are goods in?
>
>
Thank you - The text good is typed into the status column

Mike

Try the following:


Sub templatecopier()
mainsheet = ActiveSheet.Name
Dim intcounter As Integer
Dim lastrow As Integer
lastrow = ActiveSheet.UsedRange.Rows.Count
intcounter = 2
Cells(intcounter, 6).Select
Do Until intcounter = lastrow + 1
If ActiveCell.Value = "good" Then
ActiveCell.EntireRow.Copy
Sheets("Template").Select
Range("A1").Select
Selection.Insert Shift:=xlDown
Sheets(mainsheet).Select
End If
intcounter = intcounter + 1
Cells(intcounter, 6).Select
Loop
Application.CutCopyMode = False
Range("A1").Select
End Sub