title: Copy rows based on cell value and paste on a new sheet with same cell value name
body: <p>I have a DATA sheet containing an employee list with 3 columns, </p>
  
  <pre><code>COLUMN A - DEPARTMENT
  COLUMN B - EMPCODE
  COLUMN C - EMPNAME
  </code></pre>
  
  <p>Here is sample data:</p>
  
  <p><a href="https://i.stack.imgur.com/aFSUb.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/aFSUb.png" alt="Raw data"></a></p>
  
  <p>I want to split the contents of this sheet according to COLUMN A - DEPARMENT and place them on different sheets, the new sheets to be named as the department name in Column A.</p>
  
  <p>The end result should be something like this:</p>
  
  <p><a href="https://i.stack.imgur.com/q72Ym.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/q72Ym.png" alt="End result"></a></p>
  
  <p>This code checks each row. If the cell in Column A is equal to the cell below, it selects the row.</p>
  
  <pre><code>Sub CopyRows()
  
      Dim rngMyRange As Range, rngCell As Range
      With Worksheets("DATA")
       Set rngMyRange = .Range(.Range("a1"), .Range("A65536").End(xlUp))
  
       For Each rngCell In rngMyRange
              If rngCell.Value = rngCell.Offset(1, 0).Value Then
              rngCell.EntireRow.Select
           End If
  
       Next
           Selection.Copy
           Sheets.Add After:=ActiveSheet
           Rows("1:1").Select
           Selection.Insert Shift:=xlDown
           ActiveSheet.Name = Range("A1")
   End With
  
   End Sub
  </code></pre>
  
  <p>How can I make the selection stay and add more selected rows as it checks the cell value in Column A?</p>