Add sheet problem....

I would like to add a new sheet and then run the if-else statement for four times,means the if-else statement will loop for four time,then the fifth times and so on(if-else will run four time in a sheet).....Means the if-else statement loop for four time and then will add new sheet for fifth times to eight times and so on....May I know how could I do so????Help is needed urgently.....

'row 23 so on and column 1
For r = 23 To 24022

 
If Not (Cells(r, 1).Value = "") Then
        'add worksheet
        With ActiveWorkbook.Sheets
         
        .Add after:=Worksheets(Worksheets.count)


With ActiveSheet
           ‘row 23 so on and column 2
            For s = 23 To 24022 Step 10
             If Not (Cells(s, 2).Value = "" Then
            
             If Cells(s, 2).Value = "Activity" Then
                ActiveSheet.Shapes.AddShape(msoShapeRectangle, 191.25, 230.25, 
                144#,87.75). _
                Select
                Selection.Characters.Text = Join(Evaluate("transpose(" & .Cells(r, 
                1).Resize(10).Address & ")"), vbLf)
             ElseIf Cells(s, 2).Value = "Optional Activity" Then
                 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 191.25, 230.25, 
                 144#, 87.75)._
                 Select
                 Selection.Characters.Text = Join(Evaluate("transpose("
                 & .Cells(r,1).Resize(10).Address & ")"), vbLf)
              ElseIf Cells(s, 2).Value = "Decision" Then
                ActiveSheet.Shapes.AddShape(msoShapeFlowchartDecision, 191.25, 
                 230.25, 144#, 87.75). _
                 Select
                 Selection.Characters.Text = Join(Evaluate("transpose(" & .Cells(r, 
                 1).Resize(10).Address & ")"), vbLf)
               End If
                  
                 r = r + 10
                
                  End If
          
          Next s
      End with

I would like to add a new sheet and then run the if-else statement for four times,means the if-else statement will loop for four time,then the fifth times and so on(if-else will run four time in a sheet).....Means the if-else statement loop for four time and then will add new sheet for fifth times and so on....May I know how could I do so????Help is needed urgently.....

'row 23 so on and column 1
For r = 23 To 24022

 
If Not (Cells(r, 1).Value = "") Then
        'add worksheet
        With ActiveWorkbook.Sheets
         
        .Add after:=Worksheets(Worksheets.count)


With ActiveSheet
           ‘row 23 so on and column 2
            For s = 23 To 24022 Step 10
             If Not (Cells(s, 2).Value = "" Then
            
             If Cells(s, 2).Value = "Activity" Then
                ActiveSheet.Shapes.AddShape(msoShapeRectangle, 191.25, 230.25, 
                144#,87.75). _
                Select
                Selection.Characters.Text = Join(Evaluate("transpose(" & .Cells(r, 
                1).Resize(10).Address & ")"), vbLf)
             ElseIf Cells(s, 2).Value = "Optional Activity" Then
                 ActiveSheet.Shapes.AddShape(msoShapeRectangle, 191.25, 230.25, 
                 144#, 87.75)._
                 Select
                 Selection.Characters.Text = Join(Evaluate("transpose("
                 & .Cells(r,1).Resize(10).Address & ")"), vbLf)
              ElseIf Cells(s, 2).Value = "Decision" Then
                ActiveSheet.Shapes.AddShape(msoShapeFlowchartDecision, 191.25, 
                 230.25, 144#, 87.75). _
                 Select
                 Selection.Characters.Text = Join(Evaluate("transpose(" & .Cells(r, 
                 1).Resize(10).Address & ")"), vbLf)
               End If
                  
                 r = r + 10
                
                  End If
          
          Next s
      End with