Consulting

Results 1 to 3 of 3

Thread: Solved: Move rows to second worksheet based on value

  1. #1

    Question Solved: Move rows to second worksheet based on value

    What ho guys, forgive me if this has appeared before, had a search and couldn?t find anything. I got a workbook for tracking payments for parts returned back to main warehouse and the reasons for non credit/over credit etc and would like to move an entire row of data to a second sheet if we received the correct credit. I have a column where the expected amount is taken from the recieved amount and where this equals zero I would like the entire row to move to sheet 2 I?ve already come up with this from a good deal of interweb searching but for some reason just doesn?t work, Anyone have any idea what might be up....

    [vba]Sub Moveworksheets()
    Application.ScreenUpdating = False
    Dim myrange As Range
    For Each myrange In Range("m2", Range("m2").End(xlDown))
    If myrange = "0,00" Or myrange = "0" Then
    Rows(myrange.Row).EntireRow.Copy
    Sheets("Correct").Select
    'This is generally where it all goes wrong and the weeping begins
    Sheets("Correct").Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteAll
    Application.CutCopyMode = False
    Sheets("Incorrect").Select
    Rows(myrange.Row).EntireRow.Delete
    End If
    Next myrange
    Application.ScreenUpdating = True
    End Sub[/vba]

    I am (as may be obvious) fairly ignorant of VBA so please be gentle

    And ta in advance
    A Mrs Trellis of North Wales has written in to complain that the show has "an enormous fistful of rampant innuendo rammed into every crack".


  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    Sub Moveworksheets()
    Application.ScreenUpdating = False
    Dim myrange As Range
    Dim LastRow As Long
    Dim rng As Range
    For Each myrange In Range("m2", Range("m2").End(xlDown))
    If myrange = "0,00" Or myrange = "0" Then
    myrange.EntireRow.Copy
    'This is generally where it all goes wrong and the weeping begins
    With Sheets("Correct")
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
    If LastRow > 1 Or .Range("A1").Value <> "" Then
    LastRow = LastRow + 1
    End If
    .Range("a" & LastRow).PasteSpecial xlPasteAll
    End With
    If rng Is Nothing Then
    Set rng = myrange
    Else
    Set rng = Union(rng, myrange)
    End If
    End If
    Next myrange
    If Not rng Is Nothing Then rng.EntireRow.Delete
    Application.ScreenUpdating = True
    End Sub
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Massive thanks that man, for the help and the speedy reply

    I owe you a drink

    A Mrs Trellis of North Wales has written in to complain that the show has "an enormous fistful of rampant innuendo rammed into every crack".


Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •