VBA failed to loop

[jinkame123]

Dear all,

I intended to split a large excel table (~ 7,000 rows) into different sheets.
Take the following image as an example,
I wish to copy the rows from 2 (marked with an "s" in column B) to 3 (row above "E" in column B) into a separate sheet named under the "action list" column (in this case "2").

My codes works in the first round but failed to loop down to the end of the table. Just wondering if the experts around would have idea on the case ?

Sub test()
' cut rows according to string


Dim LastRow As Integer, i As Integer, AL As Long, s As Integer, e As Integer




LastRow = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row


  For i = 2 To 164


     If Range("B" & i).Value Like "S" Then
       
        Range("C" & i).Value = AL
        i = s
    
     ElseIf Range("B" & i).Value Like "End" Then
          e = i - 1
          
          ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count)).Name = AL
          
          Sheets(1).Rows(1).Copy Sheets(ThisWorkbook.Sheets.Count).Range("A1")
          Sheets(1).Rows(s & ":" & e).Copy Sheets(ThisWorkbook.Sheets.Count).Range("A2")
    
    End If
    
    Next
    
End Sub

Any suggestions would be appreciated, thanks in advance !

 

[Fluff]

Hi & welcome to MrExcel.
You have the I & S the wrong way round, try

 s = i

I think you also have the line above the wrong way as well, try

AL = Range("C" & i).Value

 

[jinkame123]

Hi & welcome to MrExcel.
You have the I & S the wrong way round, try

 s = i

I think you also have the line above the wrong way as well, try

AL = Range("C" & i).Value

Dear Fluff,
Thanks for your kind advice. I made the amendments as instructed, but the marco still failed to loop after the first round.
That said, after copying row 2 & 3 to a new sheet named "2"; the code didn't roll on to copy row 5 to 8 to a new sheet named "3".

In addition, I also noticed a weird thing when i run the code line by line:
On completion of the first round (i.e. creating and copying the targeted rows to a new sheet), the vba is appears to be looping the code on the new sheet created.

May i ask if there is any way to bring the focus back to the sheet(1) instead of the new sheet created ?

 

[Fluff]

Try

Sub test()
' cut rows according to string

   Dim LastRow As Integer, i As Integer, AL As Long, s As Integer, e As Integer
   
   With Sheets(1)
      LastRow = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 2 To LastRow + 1
         If .Range("B" & i).Value = "S" Then
            AL = .Range("C" & i).Value
            s = i
         ElseIf .Range("B" & i).Value = "End" Then
            e = i - 1
            ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count)).Name = AL
            .Rows(1).Copy Sheets(CStr(AL)).Range("A1")
            .Rows(s & ":" & e).Copy Sheets(CStr(AL)).Range("A2")
         End If
      Next i
   End With
   
End Sub

 

[jinkame123]

Try

Sub test()
' cut rows according to string

   Dim LastRow As Integer, i As Integer, AL As Long, s As Integer, e As Integer
   
   With Sheets(1)
      LastRow = .Range("A" & Rows.Count).End(xlUp).Row
      For i = 2 To LastRow + 1
         If .Range("B" & i).Value = "S" Then
            AL = .Range("C" & i).Value
            s = i
         ElseIf .Range("B" & i).Value = "End" Then
            e = i - 1
            ThisWorkbook.Sheets.Add(After:=Sheets(ThisWorkbook.Sheets.Count)).Name = AL
            .Rows(1).Copy Sheets(CStr(AL)).Range("A1")
            .Rows(s & ":" & e).Copy Sheets(CStr(AL)).Range("A2")
         End If
      Next i
   End With
   
End Sub

Thank you so much ! The modified code works perfectly !
Happy Easter !

 

[Fluff]

Glad to help & thanks for the feedback