Move INVOICE to other worksheet

[Arcticwarrio]

Hi all,

i have this at the moment:
in a sheet named CURRENT is all our data.
when the jobs done the Satus Column "F" is changed to INVOICE
and then once a day or whenever they are all moved to a new sheet named the month and year, in this case JUN 09
this works fine as it is but at the moment i have to delete the lines myself from where it took the data from in CURRENT or AtoZ then remove them in 1 go.

Simply put, i want the code to remove these lines itself.

any ideas?

this is the code at the moment

Sub move()
    Dim Cell As Range
    Dim NextRow As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("CURRENT")
    Set ws2 = Sheets("JUN 09")

   With ws2
      NextRow = .Range("F65536").End(xlUp).Row + 1
      For Each Cell In ws1.Range("F2:F10000")
         If Cell.Value = "INVOICE" Then
            NextRow = NextRow + 1
            Cell.EntireRow.Cut Destination:=.Rows(NextRow)
            'Cell.EntireRow.Delete
         End If
      Next Cell
   End With
End Sub

 

[Andrew Poulsom]

In versions of Excel after 97 you can't delete rows within a For Each ... Next loop; rows are skipped when a one is deleted. Look here:

http://www.mrexcel.com/forum/showthread.php?t=78286

 

[Arcticwarrio]

Thanks Andrew,
i'll think of something

 

[dave3009]

Could you not filter them off first then delete them

Somethig along the lines of.....

Sub Macro4()
Dim nextrow, lst As Long
nextrow = Sheets("JUN 09").Range("F" & Rows.Count).End(xlUp).Row + 1
lst = Sheets("CURRENT").Range("F" & Rows.Count).End(xlUp).Row
With Sheets("CURRENT")
    .Rows("2:" & lst).AutoFilter Field:=6, Criteria1:="INVOICE"
    .Rows("2:" & lst).SpecialCells(xlCellTypeVisible).Copy
    Sheets("JUN 09").Rows(nextrow).PasteSpecial
    .Rows("2:" & lst).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End Sub

 

[Arcticwarrio]

i used a modifyed version of Andrew's code from the post he linked.

thanks again
WOULD NEVER HAVE THOUGHT OF THIS IN A MILLION YEARS!

Sub moveit()
    Dim Cell As Range
    Dim NextRow As Long
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Set ws1 = Sheets("CURRENT")
    Set ws2 = Sheets("JUN 09")

   With ws2
      NextRow = .Range("F65536").End(xlUp).Row + 1
      For Each Cell In ws1.Range("F2:F10000")
         If Cell.Value = "INVOICE" Then
            NextRow = NextRow + 1
            Cell.EntireRow.Copy Destination:=.Rows(NextRow)
         End If
      Next Cell
   Dim x As Integer, cel2 As Range
   With Range("F2:F1000")
      For x = .Count To 1 Step -1
            If .Cells(x, 1).Value = "INVOICE" Then
               .Cells(x, 1).EntireRow.Delete
            End If
      Next x
   End With
   End With
End Sub

TAG Move and Delete

 

[Andrew Poulsom]

I think you only need one loop there:

Sub moveit()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim NextRow As Long
    Dim x As Integer
    Set ws1 = Sheets("CURRENT")
    Set ws2 = Sheets("JUN 09")
    NextRow = ws2.Range("F65536").End(xlUp).Row + 1
    With ws1.Range("F2:F1000")
        For x = .Count To 1 Step -1
            With .Cells(x, 1)
                If .Value = "INVOICE" Then
                    .EntireRow.Copy Destination:=ws2.Rows(NextRow)
                    .EntireRow.Delete
                    NextRow = NextRow + 1
                End If
            End With
        Next x
    End With
End Sub

 

[Arcticwarrio]

Yes that works fine
Thanks again

 

[Arcticwarrio]

just to throw a spanner in the works,
how would i get it to ignore any row that had a 1 on column L
sometimes i has a 1.5 or a 2 so i set it to less than 10

i get this, but is there a better way?

Sub moveme()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim NextRow As Long
    Dim x As Integer
    Set ws1 = Sheets("CURRENT")
    Set ws2 = Sheets("JUN 09")
    NextRow = ws2.Range("F65536").End(xlUp).Row + 1
    With ws1.Range("F2:F1000")
        For x = .Count To 1 Step -1
            With .Cells(x, 1)
                If .Value = "INVOICE" Then
                    If Not .Offset(, 6).Value < 10 Then
                    .EntireRow.Copy Destination:=ws2.Rows(NextRow)
                    .EntireRow.Delete
                    NextRow = NextRow + 1
                    End If
                End If
            End With
        Next x
    End With
End Sub

 

[Andrew Poulsom]

Is it?

Sub moveit()
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim NextRow As Long
    Dim x As Integer
    Set ws1 = Sheets("CURRENT")
    Set ws2 = Sheets("JUN 09")
    NextRow = ws2.Range("F65536").End(xlUp).Row + 1
    With ws1.Range("F2:F1000")
        For x = .Count To 1 Step -1
            With .Cells(x, 1)
                If .Value = "INVOICE" And Not .Offset(, 6).Value < 10 Then
                    .EntireRow.Copy Destination:=ws2.Rows(NextRow)
                    .EntireRow.Delete
                    NextRow = NextRow + 1
                End If
            End With
        Next x
    End With
End Sub

 

[Arcticwarrio]

Genius