New user and need help

[Old_skills_lost]

Here is what I need to do I have been working on a sales sheet that will
track the sales via a won loss ratio. Now what I have been trying to do is to
take all of the information from the "activity" sheet and copy or perfer move
it to a sheet based as "lost" or "Won" drop down menu.

I don't know the first thing about how to make a macro work automatic once
the menu is used.

There are a total of three sheets to this report what needs to be done. The
activities sheet which will be the only one that employees will be entering
information. The other sheets are won and lost sheet the the information will
be transfered to.

 

[Old_skills_lost]

I don't know if this will help, I have recorded a macro. I know it needs fine
tuning as it is only good for that line and it does not take into
consideration if that sale might have been won.

Sub Activities()
'
' Activities Macro
' Macro recorded 18/01/2008 by Allen Robins Intuit Launceston
'
' Keyboard Shortcut: Ctrl+Shift+A
'
Range("G5").Select
ActiveCell.FormulaR1C1 = "lost"
Rows("5:5").Select
Selection.Cut
Sheets("Lost").Select
Rows("4:4").Select
ActiveSheet.Paste
End Sub

 

[GTVT06]

I don't know if this will help, I have recorded a macro. I know it needs fine
tuning as it is only good for that line and it does not take into
consideration if that sale might have been won.

Sub Activities()
'
' Activities Macro
' Macro recorded 18/01/2008 by Allen Robins Intuit Launceston
'
' Keyboard Shortcut: Ctrl+Shift+A
'
    Range("G5").Select
    ActiveCell.FormulaR1C1 = "lost"
    Rows("5:5").Select
    Selection.Cut
    Sheets("Lost").Select
    Rows("4:4").Select
    ActiveSheet.Paste
End Sub







- Show quoted text -

hello try this
Sub try()

Dim cell As Range
Sheets("Activities").Activate
For Each cell In Range("E2:E50")
If cell.Text = "won" Then
cell.Select
Rows(cell.Row).Cut
Sheets("Won").Activate
Range("A65536").End(xlUp).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Sheets("Activities").Activate
Else
If cell.Text = "lost" Then
cell.Select
Rows(cell.Row).Cut
Sheets("Lost").Activate
Range("A65536").End(xlUp).Select
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Sheets("Activities").Activate
End If
End If
Next cell

End Sub

 

[Old_skills_lost]

Wow lookss great but when put into place I get a run-time error '9':
subscript out of range

Thank you for you help

 

[Old_skills_lost]

Was able to fix error, but now when it is ran it does not do anything am I
missing something?

 

[Old_skills_lost]

OK i am starting to get this.... Fixed the not working issue. Thank you for
all of your help!!!

Now how would I enter a line into that if I only wanted all the lines that
are being transfer from the "activities" page to both "won" and "lost" below
line 4?

 

[GTVT06]

OK i am starting to get this.... Fixed the not working issue. Thank you for
all of your help!!!

Now how would I enter a line into that if I only wanted all the lines that
are being transfer from the "activities" page to both "won" and "lost" below
line 4?






- Show quoted text -

here you go, try this. I added comments to the help you identify the
code I added so you can cut and paste it into the code your currently
using that works:

Sub try()

Dim cell As Range
Sheets("Activities").Activate
For Each cell In Range("E2:E50")
If cell.Text = "won" Then
cell.Select
Rows(cell.Row).Cut
Sheets("Won").Activate
Range("A65536").End(xlUp).Select
'Added from here
Do Until Selection.Row >= 5
If Selection.Row < 5 Then Selection.Offset(1, 0).Select
Loop
'To here
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Sheets("Activities").Activate
Else
If cell.Text = "lost" Then
cell.Select
Rows(cell.Row).Cut
Sheets("Lost").Activate
Range("A65536").End(xlUp).Select
'And from here
Do Until Selection.Row >= 5
If Selection.Row < 5 Then Selection.Offset(1, 0).Select
Loop
'To here
Selection.Insert Shift:=xlDown
Application.CutCopyMode = False
Sheets("Activities").Activate
End If
End If
Next cell


End Sub