Splitting a worksheet into separate worksheets based on a keyword in a cloumn

I need to split a worksheet based on a keyword in a column. There are 9000 rows and it takes around 3 hours to do this manually. I have code that splits the worksheets but I will have to do this 18 times and it will take too long. Here is my code for splitting worksheet. I need to implement this into a loop to loop 18 times for 18 different keywords but don't know how. Very new to VB and macros

Formula:

Sub SearchForString()



   Dim LSearchRow As Integer

   Dim LCopyToRow As Integer



   On Error GoTo Err_Execute

   

   'Start search in row 7

   LSearchRow = 7

   

   'Start copying data to row 7 in Sheet2 (row counter variable)

   LCopyToRow = 7

   

   While Len(Range("A" & CStr(LSearchRow)).Value)

   

      'If value in column E = "KEYWORD", copy entire row to Sheet2

      If Range("A" & CStr(LSearchRow)).Value = "KEYWORD" Then

      

         'Select row in Sheet1 to copy

         Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select

         Selection.Copy

         

         'Paste row into Sheet2 in next row

         Sheets("Sheet2").Select

         Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select

         ActiveSheet.Paste

         

         'Move counter to next row

         LCopyToRow = LCopyToRow + 1

         

         'Go back to Sheet1 to continue searching

         Sheets("Sheet1").Select

         

        '______________

   

   'Position on cell A3

   Application.CutCopyMode = False

   Range("A3").Select

   

   MsgBox "All matching data has been copied."

   

   Exit Sub

   

Err_Execute:

   MsgBox "An error occurred."

   

End Sub