How can I get macro to recognize every time a number changes?

Hi,

The code below copies data and places it on it's own sheet. It works great. My problem is I want it take the data and place it on it's own sheet every time the number changes. Example: Right now the below code will take the data for PO # 101012752 and place it on it's own sheet. I want to change the code so it will recognize every time the PO # changes and place it on it's own sheet without me having to go in and manually change the PO # in the code each time. Any thoughts?

Thank you so much in advance for your helpe.

Eddie.


'Copies data onto its own sheet.

    Dim WS As Worksheet
    Dim WSNew As Worksheet
    Dim rng As Range
    Dim rng2 As Range
    Dim Str As String
 
    Set WS = Sheets("Corp Paying")  '<<< Change
    'A1 is the top left cell of your filter range and the header of the first column
    Set rng = WS.Range("A1").CurrentRegion  '<<< Change
    Str = "101012752"  '<<< Change
 
    'Close AutoFilter first
    WS.AutoFilterMode = False
 
    'This example filter on the first column in the range (change the field if needed)
    rng.AutoFilter Field:=1, Criteria1:=Str
 
    Set WSNew = Worksheets.Add

    WS.AutoFilter.Range.Copy
    With WSNew.Range("A1")
        ' Paste:=8 will copy the columnwidth in Excel 2000 and higher
        .PasteSpecial Paste:=8
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        .Select
    End With
 
    '    'If you want to delete the rows in WS that you copy use this also
    '    With WS.AutoFilter.Range
    '        On Error Resume Next
    '        Set rng2 = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count) _
             '                   .SpecialCells(xlCellTypeVisible)
    '        On Error GoTo 0
    '        If Not rng2 Is Nothing Then rng2.EntireRow.Delete
    '    End With
 
    WS.AutoFilterMode = False
 
    On Error Resume Next
    WSNew.name = Str
    If Err.number > 0 Then
        MsgBox "Change the name of : " & WSNew.name & " manually"
        Err.Clear
    End If
    On Error GoTo 0
    
    End Sub

Yes it did help. Thank you very much. I'm sorry I forgot to reply quicker than this.

Eddie.