Moving entire row to new sheet help... Using a code I found through search, but it's not quit working.

[GaryG9595]

Hello I am trying to use a code I found on here, but I am running into a bit of a problem... It cuts the row from The 'data-dump' sheet, but I do not know where it is going. It's not going into the 'Archive' sheet that I created.

I basically have a few people working in a spreadsheet with data ( "Data-Dump" ) Columns A:DO
I want to fill in Column DH on 'Data-Dump' sheet with an "x" and have that entire row move to the next empty row on the 'Archive' sheet for later reference if needed starting in row 2 as it has the same headers as 'Data-Dump'

These rows from the 'DATA-DUMP' sheet have formulas as well, but they can and need to be just values on the 'Archive' sheet.

Sub Archive()
Dim lr As Long, lr2 As Long
lr = Worksheets("DATA-DUMP").UsedRange.Rows.Count
lr2 = Worksheets("Archive").UsedRange.Rows.Count
For Each cell In Range("DH1:DH" & lr)
If cell.Value = "x" Then
cell.EntireRow.Copy Destination:=Worksheets("Archive").Range("A2" & lr2 + 1)
cell.EntireRow.Delete
lr2 = Worksheets("Archive").UsedRange.Rows.Count
End If
Next cell
End Sub

Thanks in advance...

 

[DocAElstein]

Re: Moving entire row to new sheet

Hi again jptsunil

Thank you verymuchDocaElstein it works but it copies and pastes the row, I need cut and paste. …..

……New code with the main new lines shown in orange which deletes entire row after copying and pasting the Info ..

[color=blue]Option[/color] [color=blue]Explicit[/color]
[color=lightgreen]'_______________________________________________________________________________________-[/color]
[color=lightgreen]'_______________________________________________________________________________[/color]
 
[color=lightgreen]'_______________________________________________________________________________________________-[/color]
[color=lightgreen]'[/color]
[color=blue]Private[/color] [color=blue]Sub[/color] Worksheet_Change([color=blue]ByVal[/color] Target [color=blue]As[/color] Range) 'What happens when worksheet is Changed:-
[color=blue]On[/color] [color=blue]Error[/color] [color=blue]GoTo[/color] TheEnd: [color=lightgreen]'"Handling the error, take alternative action to default on an error[/color]
[color=blue]Dim[/color] wsr [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wsr = ThisWorkbook.Worksheets("Running") [color=lightgreen]'Give abbreviation Methods, Properties, etc. of worksheets Object obtainable through the .Dot[/color]
[color=blue]Dim[/color] wksHere [color=blue]As[/color] Worksheet: [color=blue]Set[/color] wksHere = ThisWorkbook.Worksheets("program") [color=lightgreen]'Mostly redundant as code is ( must be ) in This sheet Module usually[/color]
[color=blue]Dim[/color] rngAim [color=blue]As[/color] Range [color=lightgreen]'The range where you want an input to set off the code.[/color]
[color=blue]Dim[/color] rr [color=blue]As[/color] [color=blue]Long[/color], rp [color=blue]As[/color] [color=blue]Long[/color], lrr [color=blue]As[/color] [color=blue]Long[/color], lrp [color=blue]As[/color] [color=blue]Long[/color] [color=lightgreen]'Variable for rows, last rows in sheets. Assume our File has a reasonably well defined end. Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster.[/color]
[color=blue]Let[/color] lrp = wksHere.Cells(Rows.Count, "A").End(xlUp).Row [color=lightgreen]'The [color=blue]End[/color] property (with argument Up) applied to last cell in coluimn A returns a new Range ( cell ) where an entry is found, which in turn has the row property applied to return the row of that range ( cell )[/color]
[color=blue]Set[/color] rngAim = wksHere.Range("N2:N" & lrp & "") [color=lightgreen]'Set up Target Range as N column staring at 2 and going down to last entry.[/color]
    [color=blue]If[/color] Intersect(rngAim, Target) [color=blue]Is[/color] [color=blue]Nothing[/color] [color=blue]Then[/color]  [color=lightgreen]' Not too sure why this particular way is chosen, possibly Professionals know from experience it works best often??[/color]
    [color=lightgreen]'Case you did not type in rngAim - Do nothing, - end of if - end of sub[/color]
    [color=blue]Else[/color] [color=lightgreen]' case you targeted rng Aim[/color]
    [color=blue]Let[/color] lrr = wsr.Cells.Find(What:="*", After:=wsr.Cells(1, 1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row [color=lightgreen]'Get last Row with entry anywhere for Sheet1. Method: You start at first cell then go backwards (which effectively starts at end of sheet), searching for anything ( = * ) by rows, then get the row number. This allows for different excel versions with different available Row numbers) Just a different method that finds last row in sheet rather than row for last entry in particular cell.[/color]
    Target.Offset(0, -13).Resize(1, 14).Copy [color=lightgreen]'Take a range made from a cell offset 12 to the left from your targetteg cell and resized to 14 columns[/color]
    wsr.Range("A" & lrr + 1 & "").PasteSpecial xlPasteAllUsingSourceTheme [color=lightgreen]'Select first free cell in column A of running sheet and paste in from clipboard. A different argument may be appropriate: Post #25 http://www.mrexcel.com/forum/excel-questions/785462-visual-basic-applications-copy-value-paste-worksheet-same-name-value-3.html[/color]
    [color=orange]Application.EnableEvents = [color=blue]False[/color] [/color] [color=lightgreen]'Turn these Code types off, to Prevent this code starting again when next line changes sheet[/color]
    [color=orange]Target.EntireRow.Delete[/color] [color=lightgreen]'Delete entire row of last copied Range[/color]
    [color=orange]Application.EnableEvents= [color=blue]True[/color][/color]  [color=lightgreen]'Turn these code types back on[/color]
    [color=blue]End[/color] [color=blue]If[/color]
TheEnd: [color=lightgreen]'Come here if anything goes wrong, do anything that should always be done if Code errors[/color]
Application.CutCopyMode = [color=blue]False[/color] [color=lightgreen]'Stop screen flicker after paste[/color]
Application.EnableEvents = [color=blue]True[/color] [color=lightgreen]'Turn these code types back on[/color]
End [color=blue]Sub[/color]

. Alan

P.s. Some additional lines of error handling are also included to ensure important things are turned back on should an error occur.