Cutting and Pasting individual cells that meet criteria to same row of different column

[tdepke1]

I'm a n00b and I've been searching the forums and the closest thing I can find to my problem was addressed here: Simple Macro to cut and paste based on cell value

I'm trying to have any cells in column M that are greater than 0 be cut and paste into a column 3 columns to the right of the original in the same row in the same worksheet. This code below was from the original forum

Sub atest()
Dim LR As Long, i As Long
With Sheets("All")
    LR = .Range("C" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("C" & i)
            If .Value Like "*Time*" Then .EntireRow.Cut Destination:=Sheets("All Time").Range("C" & Rows.Count).End(xlUp).Offset(1, -2)
        End With
    Next i
End With
End Sub

The code I've got looks like this:

Dim LR As Long, i As Long
With Sheets("Sheet1")
    LR = .Range("M" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("M" & i)
            If .Value > 0 Then .Cut Destination:=Sheets("Sheet1").Range("M" & Rows.Count).End(xlUp).Offset(0, 3)
            ActiveSheet.Paste
        End With
    Next i
End With

It returns an error saying:

Run-time error '1004'
Paste method of Worksheet class failed

Running the macro currently only cuts the first value greater than 0 in Column M and pastes it into Column P (good!), but into the last row with a value greater than 0 from Column M (BAD). So I'm needing
1. it to do this for all cells in Column M greater than 0
2. paste it in the same row of Column P

 

[Fluff]

Hi & welcome to MrExcel.
Try it like

Dim LR As Long, i As Long
With Sheets("Sheet1")
    LR = .Range("M" & Rows.Count).End(xlUp).Row
    For i = 1 To LR
        With .Range("M" & i)
            If .Value > 0 Then .Cut Destination:=.Offset(0, 3)
        End With
    Next i
End With

 

[tdepke1]

Thanks for the quick reply! That solved that question!

I have a follow-up question that is very similar. If I'm trying to have any cells in a separate column (Column B) that contain the word "stipend" then I'd like to have the cell 3 columns to the right have "Work" and the cell one column to the right of that (4 columns to the right of Column B) have "Stipend" in it. Here is what I currently have:

Dim LR3 As Long, i3 As Long
With Sheets("Sheet1")
    LR3 = .Range("B" & Rows.Count).End(xlUp).Row
    For i3 = 1 To LR3
        With .Range("B" & i3)
            If .Value = "*stipend*" Then .Offset(0, 3).Select
    ActiveCell.FormulaR1C1 = "Work": .Offset(0, 1).Select  ActiveCell.FormulaR1C1 = "Stipend"
    
        End With
    Next i3
End With

The part after the "Work": is what I'm having trouble with.

Thanks so much for your help!

 

[Fluff]

How about

Dim LR3 As Long, i3 As Long
With Sheets("Sheet1")
    LR3 = .Range("B" & Rows.Count).End(xlUp).Row
    For i3 = 1 To LR3
        With .Range("B" & i3)
            If .Value Like "*stipend*" Then
               .Offset(, 3).Resize(, 2).Value = Array("Work", "Stipend")
            End If
        End With
    Next i3
End With

 

[tdepke1]

Thank you a ton for both answers! 110%!

 

[Fluff]

You're welcome & thanks for the feedback.