Cut Contents and Paste


M

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
 
Ad

Advertisements

P

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
 
B

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
 
M

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.

Per Jessen said:
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 said:
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
 
M

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


Bernard Liengme said:
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

MCheru said:
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
 
P

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

MCheru said:
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.

Per Jessen said:
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 said:
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
 
Ad

Advertisements

B

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

MCheru said:
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


Bernard Liengme said:
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

MCheru said:
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
 
M

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?

Per Jessen said:
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 said:
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.

Per Jessen said:
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
 
P

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

MCheru said:
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?

Per Jessen said:
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 said:
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
 
Ad

Advertisements

M

MCheru

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

Per Jessen said:
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

MCheru said:
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?

Per Jessen said:
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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Paste failing after cut 7
cut/paste columns efficiency 13
Cut and Paste 4
CopyPasteCode 5
Different Results from the Same Macro 2
CPSCount 2
code breaks in macro 1
Capture 4

Top