Retail Stock Check

Many members are unable to see images in the *.png format due to forum compatibility issues with some browsers.

If you need to post an image post it in the *.jpg format.

Even better than posting images... post a SMALL sample file. That way we can test solutions directly in the file with the relevant data.

Based upon the picture, you wish to copy to a new page those items having a !!! in column E? Is this correct? or do you wish for something else?

Try this:

Option Explicit

Sub MoveData()
    Dim lr As Long, i As Long
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Dim lr2 As Long
    Application.ScreenUpdating = False
    For i = 2 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("E" & i) = "!!!" Then
            s1.Range("E" & i).EntireRow.Copy s2.Range("A" & lr2 + 1)
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"
End Sub

How to install your new code

1. Copy the Excel VBA code
2. Select the workbook in which you want to store the Excel VBA code
3. Press Alt+F11 to open the Visual Basic Editor
4. Choose Insert > Module
5. Edit > Paste the macro into the module that appeared
6. Close the VBEditor
7. Save your workbook (Excel 2007+ select a macro-enabled file format, like *.xlsm)

To run the Excel VBA code:

1. Press Alt-F8 to open the macro list
2. Select a macro in the list
3. Click the Run button

Hi
I think Alan hasn't defined the variable 'lr'. This line needs to be inserted:

lr = s1.Range("A" & Rows.Count).End(xlUp).Row

Sub MoveData()
    Dim lr As Long, i As Long
    Dim s1 As Worksheet, s2 As Worksheet
    Set s1 = Sheets("Sheet1")
    Set s2 = Sheets("Sheet2")
    Dim lr2 As Long
    Application.ScreenUpdating = False
    lr = s1.Range("A" & Rows.Count).End(xlUp).Row
    For i = 2 To lr
        lr2 = s2.Range("A" & Rows.Count).End(xlUp).Row
        If s1.Range("E" & i) = "!!!" Then
            s1.Range("E" & i).EntireRow.Copy s2.Range("A" & lr2 + 1)
        End If
    Next i
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "complete"

End Sub

DBY

@DBY. Thanks. Oversight on my part. This is what happens sometimes when you don't have a sample workbook to test.