Hallo again everybody!

Firstly –

I’ve got a simple but long macro to replace any cells that do not contain 49 or 73 and replace them with 49, so that I end up with only a 49 or a 73 in the cells… I am sure you guys know of a much cleverer way to do that bit! At the moment each time I find a number that is not a 49 or 73 I add it to my macro, which is getting longer each month!

And secondly and more complicated and what I guess I need to do between finding and before replacing non 49 and non 73 cells is –

When a cell in column E contains something other than 49 or 73 I want to copy that row from A:J to a new spreadsheet

So if E6 has 25 in for example cells A6:J6 will be copied to a new spreadsheet

There are lots of rows that will have non 49 and non 73 so what my ultimate goal is, is to end up with one spreadsheet with all the non 49 and 73 cells A:J in it and for all non 49 and non 73 to be changed to 49

My working but clunky macro so far is as follows – 



Sub CHANGETO49IFNOT73()

  Dim Wks As Worksheet

'Select the proper sheet before starting
    Sheets("Europe").Select

'Loop through the Worksheets
   For Each Wks In Worksheets

'Check if the Worksheet is to be skipped -

     If Wks.Name = ""Cost" Or Wks.Name = "Front Page" Or Wks.Name = "YTD" Then GoTo Skip
       
'Prevent screen flicker while running macro
    Application.ScreenUpdating = False

'Activate the worksheet
    Wks.Activate

'.....MAIN MACRO....

    Columns("E:E").Select

    Selection.Replace What:="10", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="11", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="12", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="14", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="26", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="27", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="30", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False
        
    Selection.Replace What:="32", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="50", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

    Selection.Replace What:="58", Replacement:="49", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False

'.....END OF MAIN MACRO....

Skip:
   Next Wks


'Return to Front Page
    Sheets("Front Page").Select
    Range("A1").Select
    
    ActiveWorkbook.Save

    Application.ScreenUpdating = True


End Sub
Many thanks in advance

Rae