Excel 2000 Macro Debug

Question

Please may I have some help with the macro below. The macro sorts and then moves a row (Nut) to Store. The rows to be moved have an X in the row. Other rows not having an X are stay where they are. It works for one row but I cannot work out how how to get it repeat to move all rows until there are no more with an X to move.

 Sub Macro1()

'

' Macro1 Macro

' Macro recorded 20/11/2010 by Gerald Cornell

'

' Keyboard Shortcut: Ctrl+e

'

'

'

Sub Macro10()

Range("OSCHQS").Select

Selection.Sort Key1:=Range("D9:D35"), Order1:=xlAscending,

Header:= _

xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _

xlTopToBottom

Application.Goto Reference:="START"

Cells.Find(What:="xxx", After:=ActiveCell, LookIn:=xlFormulas,

_

LookAt:=xlPart, SearchOrder:=xlByColumns,

SearchDirection:=xlNext _

, MatchCase:=False).Activate

Application.Goto Reference:="START"

ActiveCell.Offset(0, -6).Range("A9:H9").Select

ActiveWorkbook.Names.Add Name:="NUTS", RefersToR1C1:= _

"=UNPDCHQS!R9C1:R9C8"

Application.Goto Reference:="STORE"

Selection.EntireRow.Insert

Application.Goto Reference:="NUTS"

Selection.Copy

Application.Goto Reference:="STORE"

ActiveCell.Offset(-1, 0).Range("A1:H1").Select

ActiveSheet.Paste

Application.Goto Reference:="STORE"

ActiveCell.Offset(-1, 0).Range("G1").Select

Application.CutCopyMode = False

Selection.ClearContents

ActiveCell.Offset(-3, 0).Range("G1").Select

Selection.EntireRow.Insert

Application.Goto Reference:="NUTS"

Application.CutCopyMode = False

Selection.EntireRow.Delete

ActiveWorkbook.Names("NUTS").Delete

End Sub

---

Hope this helps, Gerry Cornell

Answer 1

Since it doesn't refer to a single cell as stated by the OP, then perhaps

Set DestRng = Range("Store").EntireRow

or

Set DestRng = Range("Store")(1)

---

--

Tom Ogilvy

note: If you receive an answer to your question - please mark that answer or answers so others know the question has been answered.

Answer 2

Then this should do it:

Set DestRng=Range("Store") 'Note that Store has to refer to a single cell, ie A2, as the macro cut multiple rows

Per

Answer 3

Per

Need some further help please?

Your suggestion fails at this line.

Set DestRng = Worksheets("StoreSh").Range("A" & Rows.Count).End(xlUp).Offset(1) 'change worksheet name  to suit

Store is a named Range in the same worksheet. It is located on a single row, columns A to H.

TIA 

---

Gerry Cornell

Answer 4

You use an autofilter to find all cells with xxx in column G, then cut all rows with visible cells in column G and paste into destination worksheet.

Based on your code, I think this should do it:

Sub MoveNuts()

Dim FilterRng As Range

Dim CutRng As Range

Dim DestRng As Range

Range("OSCHQS").Sort Key1:=Range("D9"), Order1:=xlAscending, Header:= _

    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Set FilterRng = Range("G1", Range("G" & Rows.Count).End(xlUp))

Set CutRng = FilterRng.Offset(1)

Set DestRng = Worksheets("StoreSh").Range("A" & Rows.Count).End(xlUp).Offset(1) 'change worksheet name  to suit

FilterRng.AutoFilter field:=1, Criteria1:="xxx"

CutRng.SpecialCells(xlCellTypeVisible).EntireRow.Cut Destination:=DestRng

CutRng.EntireRow.Delete

End Sub

Regards,

Per