Cut Contents and Paste

[MCheru]

I am trying to create a macro that will search every cell in Column A for
ZRP3 when it finds these contents cut the entire row it exists in up to
column L, and paste all the rows that got copied into a new worksheet. This
what I have written so far but it’s not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[Per Jessen]

Hi

Look at this:

Sub CutContentsandPaste()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim LastRow As Long
Dim off As Long

Set wsA = Worksheets("Sheet1") ' Change to suit
Set wsB = Worksheets.Add

wsA.Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
off = 0

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
End If
Next
End Sub

Regards,
Per

 

[Bernard Liengme]

More or less the same as Per's - took me time to test it

Sub moveIt()
k = 1
Worksheets("Sheet1").Activate
mylast = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For j = 1 To mylast
If Cells(j, "A") = "ZRP3" Then
Cells(j, "A").EntireRow.Cut Worksheets("Sheet2").Cells(k, "A")
Cells(j, "A").EntireRow.Delete Shift:=xlShiftUp
k = k + 1
End If
Next j
End Sub

best wishes

 

[MCheru]

Thank you for you're help. I appreciate your feedback. The macro appears to
be getting hung up on this part.

Destination:=wsB.Range("A1").Offset(off, 0), but I am not sure how to fix it.

Hi

Look at this:

Sub CutContentsandPaste()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim LastRow As Long
Dim off As Long

Set wsA = Worksheets("Sheet1") ' Change to suit
Set wsB = Worksheets.Add

wsA.Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
off = 0

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
End If
Next
End Sub

Regards,
Per

I am trying to create a macro that will search every cell in Column A for
ZRP3 when it finds these contents cut the entire row it exists in up to
column L, and paste all the rows that got copied into a new worksheet.
This
what I have written so far but it’s not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[MCheru]

I am using this variation I posted below which is a combination of yours and
mine and it's sort of working, the only problem is that the ZRP3 rows are
still on Sheet 1 they are not being cut out completely. Ideally I want the
rows with ZRP3 to be gone from Sheet 1 and be on the ZRP3 Remaining worksheet.


Sub moveIt()
Sheets.Add
Set newsht = ActiveSheet
newsht.Name = "ZRP3 Remaining"
Sheets("Sheet1").Select
k = 1
Worksheets("Sheet1").Activate
mylast = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For j = 1 To mylast
If Cells(j, "A") = "ZRP3" Then
Cells(j, "A").EntireRow.Cut Worksheets("ZRP3 Remaining").Cells(k, "A")
Cells(j, "A").EntireRow.Delete Shift:=xlShiftUp
k = k + 1
End If
Next j
End Sub

More or less the same as Per's - took me time to test it

Sub moveIt()
k = 1
Worksheets("Sheet1").Activate
mylast = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For j = 1 To mylast
If Cells(j, "A") = "ZRP3" Then
Cells(j, "A").EntireRow.Cut Worksheets("Sheet2").Cells(k, "A")
Cells(j, "A").EntireRow.Delete Shift:=xlShiftUp
k = k + 1
End If
Next j
End Sub

best wishes
--
Bernard V Liengme
Microsoft Excel MVP
http://people.stfx.ca/bliengme
remove caps from email

I am trying to create a macro that will search every cell in Column A for
ZRP3 when it finds these contents cut the entire row it exists in up to
column L, and paste all the rows that got copied into a new worksheet.
This
what I have written so far but it's not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[Per Jessen]

Thanks for your reply.

You are a victim of word wrap. The line mentioned should be a part of the
line above. To fix it remove the carriage return between this line and the
line above.

Regards,
Per

Thank you for you're help. I appreciate your feedback. The macro appears
to
be getting hung up on this part.

Destination:=wsB.Range("A1").Offset(off, 0), but I am not sure how to fix
it.

Hi

Look at this:

Sub CutContentsandPaste()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim LastRow As Long
Dim off As Long

Set wsA = Worksheets("Sheet1") ' Change to suit
Set wsB = Worksheets.Add

wsA.Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
off = 0

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
End If
Next
End Sub

Regards,
Per

I am trying to create a macro that will search every cell in Column A
for
ZRP3 when it finds these contents cut the entire row it exists in up to
column L, and paste all the rows that got copied into a new worksheet.
This
what I have written so far but it’s not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[Bernard Liengme]

Send me the workbook - to me not the newsgroup; remove TRUENORTH to get my
real email
best wishes
--
Bernard V Liengme
Microsoft Excel MVP
http://people.stfx.ca/bliengme
remove caps from email

I am using this variation I posted below which is a combination of yours
and
mine and it's sort of working, the only problem is that the ZRP3 rows are
still on Sheet 1 they are not being cut out completely. Ideally I want
the
rows with ZRP3 to be gone from Sheet 1 and be on the ZRP3 Remaining
worksheet.


Sub moveIt()
Sheets.Add
Set newsht = ActiveSheet
newsht.Name = "ZRP3 Remaining"
Sheets("Sheet1").Select
k = 1
Worksheets("Sheet1").Activate
mylast = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For j = 1 To mylast
If Cells(j, "A") = "ZRP3" Then
Cells(j, "A").EntireRow.Cut Worksheets("ZRP3 Remaining").Cells(k, "A")
Cells(j, "A").EntireRow.Delete Shift:=xlShiftUp
k = k + 1
End If
Next j
End Sub

More or less the same as Per's - took me time to test it

Sub moveIt()
k = 1
Worksheets("Sheet1").Activate
mylast = Cells(Cells.Rows.Count, "A").End(xlUp).Row
For j = 1 To mylast
If Cells(j, "A") = "ZRP3" Then
Cells(j, "A").EntireRow.Cut Worksheets("Sheet2").Cells(k, "A")
Cells(j, "A").EntireRow.Delete Shift:=xlShiftUp
k = k + 1
End If
Next j
End Sub

best wishes
--
Bernard V Liengme
Microsoft Excel MVP
http://people.stfx.ca/bliengme
remove caps from email

I am trying to create a macro that will search every cell in Column A
for
ZRP3 when it finds these contents cut the entire row it exists in up to
column L, and paste all the rows that got copied into a new worksheet.
This
what I have written so far but it's not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[MCheru]

You were right thanks for the tip. I am still having one problem though.
Although all the rows with ZRP3 are disappearing only the first line is
pasting on the new worksheet. Any thoughts?

Thanks for your reply.

You are a victim of word wrap. The line mentioned should be a part of the
line above. To fix it remove the carriage return between this line and the
line above.

Regards,
Per

Thank you for you're help. I appreciate your feedback. The macro appears
to
be getting hung up on this part.

Destination:=wsB.Range("A1").Offset(off, 0), but I am not sure how to fix
it.

Hi

Look at this:

Sub CutContentsandPaste()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim LastRow As Long
Dim off As Long

Set wsA = Worksheets("Sheet1") ' Change to suit
Set wsB = Worksheets.Add

wsA.Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
off = 0

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
End If
Next
End Sub

Regards,
Per

"MCheru" <[email protected]> skrev i meddelelsen
I am trying to create a macro that will search every cell in Column A
for
ZRP3 when it finds these contents cut the entire row it exists in up to
column L, and paste all the rows that got copied into a new worksheet.
This
what I have written so far but it’s not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[Per Jessen]

Hi

This should do it:

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
off=off+1
End If
Next

Regards,
Per

You were right thanks for the tip. I am still having one problem though.
Although all the rows with ZRP3 are disappearing only the first line is
pasting on the new worksheet. Any thoughts?

Thanks for your reply.

You are a victim of word wrap. The line mentioned should be a part of the
line above. To fix it remove the carriage return between this line and
the
line above.

Regards,
Per

Thank you for you're help. I appreciate your feedback. The macro
appears
to
be getting hung up on this part.

Destination:=wsB.Range("A1").Offset(off, 0), but I am not sure how to
fix
it.

:

Hi

Look at this:

Sub CutContentsandPaste()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim LastRow As Long
Dim off As Long

Set wsA = Worksheets("Sheet1") ' Change to suit
Set wsB = Worksheets.Add

wsA.Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
off = 0

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
End If
Next
End Sub

Regards,
Per

"MCheru" <[email protected]> skrev i meddelelsen
I am trying to create a macro that will search every cell in Column A
for
ZRP3 when it finds these contents cut the entire row it exists in up
to
column L, and paste all the rows that got copied into a new
worksheet.
This
what I have written so far but it’s not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub

 

[MCheru]

That's the ticket. Thank so much for you're help!

Hi

This should do it:

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
off=off+1
End If
Next

Regards,
Per

You were right thanks for the tip. I am still having one problem though.
Although all the rows with ZRP3 are disappearing only the first line is
pasting on the new worksheet. Any thoughts?

Thanks for your reply.

You are a victim of word wrap. The line mentioned should be a part of the
line above. To fix it remove the carriage return between this line and
the
line above.

Regards,
Per

"MCheru" <[email protected]> skrev i meddelelsen
Thank you for you're help. I appreciate your feedback. The macro
appears
to
be getting hung up on this part.

Destination:=wsB.Range("A1").Offset(off, 0), but I am not sure how to
fix
it.

:

Hi

Look at this:

Sub CutContentsandPaste()
Dim wsA As Worksheet
Dim wsB As Worksheet
Dim LastRow As Long
Dim off As Long

Set wsA = Worksheets("Sheet1") ' Change to suit
Set wsB = Worksheets.Add

wsA.Activate
LastRow = Range("A" & Rows.Count).End(xlUp).Row
off = 0

For r = LastRow To 1 Step -1
If Range("A" & r).Value = "ZRP3" Then
Range(Cells(r, "A"), Cells(r, "L")).Cut
Destination:=wsB.Range("A1").Offset(off, 0)
End If
Next
End Sub

Regards,
Per

"MCheru" <[email protected]> skrev i meddelelsen
I am trying to create a macro that will search every cell in Column A
for
ZRP3 when it finds these contents cut the entire row it exists in up
to
column L, and paste all the rows that got copied into a new
worksheet.
This
what I have written so far but it’s not quite doing the job

Sub CutContentsandPaste()
Range("A1").Select
ActiveCell.FormulaR1C1[-1]= "ZRP3"
Range("A:L").Select
Selection.Cut
Sheets.Add
ActiveSheet.Paste
End Sub