So what I am trying to do is copy a row of information when an item in the 'k' column which will say 'recieved'. So what my code needs to do is copy the row of information on that row that says 'recieved' to sheet 2 and then remove it from sheet 1 and moves all the data from sheet 1 up to close the gap. Here is the code that I am using.

    Sub example()

    For Each ce In Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)

    If Not IsEmpty(ce) Then

    Sheets("sheet2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 18).Value = Range(ce, ce.Offset(0, 17)).Value

    End If

    Next ce

    End Sub

I realize that this code moves all of my data and i only need it to move rows that go to the state that says 'recieved'and that row will vary. Thank you in advance!

Recommended Answers

All 5 Replies

I'm not sure I understand your whole question but here is code I did in Excel 2003 that will do what I think you are asking.

    Dim MyRow As Integer
    Dim MyCell As String
    Dim LookCell As String
    Dim TargetRow As Integer
    Dim TargetRange As String


    'Find first open row on sheet 2
    TargetRow = 1
    Do While Sheet2.Range("A" & CStr(TargetRow)).Value <> Empty
        TargetRow = TargetRow + 1
    Loop
    TargetRange = "A" & CStr(TargetRow) & ":K" & CStr(TargetRow)
    'Search Sheet 1 for K column = "received"
    MyRow = 2
    MyCell = "A" & CStr(MyRow)
    LookCell = "K" & CStr(MyRow)
    Do While Sheet1.Range(MyCell).Value <> Empty
        If Sheet1.Range(LookCell).Value = "received" Then
            Sheet2.Range(TargetRange).Value = Sheet1.Range(MyCell & ":K" & CStr(MyRow)).Value
            Sheet1.Range(MyCell).EntireRow.Delete (xlShiftUp)
            TargetRow = TargetRow + 1
            TargetRange = "A" & CStr(TargetRow) & ":K" & CStr(TargetRow)
        Else
            MyRow = MyRow + 1
        End If
        MyCell = "A" & CStr(MyRow)
        LookCell = "K" & CStr(MyRow)
    Loop

Thank you so much! I will give this a try here in a bit.

Okay I just got a chance to try it and it comes up with an invalid outside procedure error. I am looking into it. But any insight would also be helpful. Thanks!

After the fact it wasn't entirely clear if you were in VBA or VB6.
The copy method is a bit odd in the code I posted.
I just did the code in vb6 using the simple range.copy and then specialpaste and it seemed to work fine.
The TargetRange is now "A" & TargetRow only. I also use the ucase to avoid any problem with capital letters. I ended up with this:

        If UCase(Sheet1.Range(LookCell).Value) = "RECEIVED" Then
            CellsToCopy = "A" & CStr(MyRow) & ":K" & CStr(MyRow)
            Sheet1.Range(CellsToCopy).Copy
            Sheet2.Range(TargetRange).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
            'Sheet2.Range(TargetRange).Value = Sheet1.Range(MyCell & ":K" & CStr(MyRow)).Value
            Sheet1.Range(MyCell).EntireRow.Delete (xlShiftUp)
            TargetRow = TargetRow + 1
            TargetRange = "A" & CStr(TargetRow) & ":K" & CStr(TargetRow)
        Else
            MyRow = MyRow + 1
        End If

Other than that I don't know.

This is all solved thank you all for your help!

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.