Cut and Paste rows

[marshybid]

Hi, can anyone help me with the following;

I have my source data for a pivot table in Sheets("Raw Data") after the pivot table has been created using this source data I want to go through each row of the Sheets("Raw Data") and identify if cell("d2") <> "hello" (example only), if true then cut the entire row and paste into a new sheet, repeat until end of rows in Sheets("Raw Data").

Thanks,

Marshybid

[Aussiebear]

G'day Marshbid,

I was going to offer this as a thought starter, but it is a derivative of some code that either MD or Bob ( My apologies but I can't remember who at this moment) provided. Bear in mind it is not looping through each line but requires a value in Column 4 to be manually changed from "hello". Its not "the solution" but may give you some idea.

Some of the others may kindly belt this into shape for you



Option Explicit
Option Compare Text

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = 4 And Target.Row > 1 Then
'Copy data to "NewSheet" and clear data from "Raw Data" worksheet
If Target <> "Hello" Then DoClear Target
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
On Error Resume Next

End Sub

Sub DoClear(Target As Range)
Dim lRow As Long
Dim cRow As Long
lRow = Sheets("NewSheet").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
With ActiveSheet
Range(.Cells(Target.Row, 1), .Cells(Target.Row, 5)).Copy
With Sheets("NewSheet")
.Range(.Cells(lRow, 1).Cells(lRow, 5)).PasteSpecial xlValues
.Range(.Cells(lRow - 1, 1), .Cells(lRow - 1, 5)).Copy
.Range(.Cells(lRow, 1), .Cells(lRow, 5)).PasteSpecial xlFormats
End With
Application.CutCopyMode = False

cRow = Target.Row
.Range("A" & cRow & ":E" & cRow).ClearContents
End With

End Sub

[marshybid]

Thanks Aussiebear, I'll have a closer look at this as soon as I get a chnace (probably this weekend). I don't suppose there is any chance you can help with my previous query??? Removing Pivot Items, any help greatle appreciated

Marshybid :think:

[Aussiebear]

Sorry Marshybid, but I'm a confirmed novice with this stuff.

[lucas]

Just passing by Ted but here is what I was able to get to work....
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lrow
Dim cRow
' Copy and paste "Cleared" row to Completed Work sheet
If Target.Cells.Count > 1 Then Exit Sub
Application.ScreenUpdating = False
Application.EnableEvents = False
If Target.Column = 4 And Target.Row > 1 And Target = "hello" Then
lrow = Sheets("Completed Work").Cells(Rows.Count, 1).End(xlUp).Offset(1).Row
With ActiveSheet
.Range(.Cells(Target.Row, 1), .Cells(Target.Row, 8)).Copy
With Sheets("Completed Work")
.Range(.Cells(lrow, 1), .Cells(lrow, 8)).PasteSpecial xlValues
' .Range(.Cells(lRow - 1, 1), .Cells(lRow - 1, 8)).Copy
' .Range(.Cells(lRow, 1), .Cells(lRow, 8)).PasteSpecial xlFormats
' .Cells(lRow, 20) = Format(Now(), "dd/mm/yy")
End With
' Reset the default values for the row just copied
cRow = Target.Row
.Range("A" & cRow & ":H" & cRow).ClearContents
' Application.EnableEvents = True
End With
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub


see attached file

[lucas]

with your file Ted....

[Aussiebear]

.... There's something very familiar about this bit of code...


I had tried to amend the original code which I use to manually cut and paste, to suit Marshy's objective but somewhere between being logical and being me... I stuffed it up. :rotlaugh:

Thanks for getting me out of the smelly stuff

[Aussiebear]

Next question here is... how do we get this to loop through rather than have to do it all manually?