Разделить диапазоны с различным количеством строк на одном листе на отдельные листы на основе значений одного столбца

Question

Я пытаюсь разделить данные из листов («ИСТОРИЯ ПОСЕЩЕНИЯ») на различное количество листов в одной книге, которым созданы и назначены стандартные имена Excel (Sheet1, Sheet2 .... ..SheetX) где число листов определяется числом уникальных значений в столбце Q. Q - это основной столбец сортировки, поэтому данные структурированы таким образом, что все уникальные значения находятся вместе.

Я создал подпрограмму ниже, и она только копирует значение в ячейке Q2 в ИСТОРИЯ ПОСЕЩЕНИЯ в A3 на каждом последующем листе. Он почти работает в том смысле, что копирует данные в правильное начальное поле на каждом листе, но данные не верны, и кажется, что они не копируют или не записывают правильный диапазон данных. Данные, которые мне нужны, это блок строк, где Q одинаково, включая столбцы от A до P.

Когда я перехожу в режим отладки, создается впечатление, что переменные LR, Rw и Rw2 имеют правильные значения, сохраненные, чтобы команда Range("A & Rw2:P & Rw").Select выбрала правильные данные, но не выдает результаты, которые я ожидаю.

Я подозреваю, что здесь проблема. Любой совет будет оценен

Sub CutAndPasteBlocksOfDataBetweenSheets()
Dim LR As Long, Rw As Long, Rw2 As Long
LR = Range("Q" & Rows.Count).End(xlUp).Row  'last row with data
Rw2 = 2
For Rw = 2 To LR Step 1                    'from the top down, compare
On Error Resume Next
If Range("Q" & Rw).Value <> Range("Q" & Rw + 1).Value Then _
Sheets.Add After:=Sheets(Sheets.Count)
Sheet1.Select
Range("A & Rw2:P & Rw").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Sheet" & Sheets.Count - 1).Select
Range("A3").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
ActiveSheet.Paste    
Sheets("VISIT HISTORY").Select
If Range("Q" & Rw).Value <> Range("Q" & Rw + 1).Value Then _
Rw2 = Rw + 1    
Next Rw
End Sub

Комментарий указал мне правильное направление - спасибо. Для всех, кого это может заинтересовать, рабочий код выглядел так:

Sub CutAndPasteBlocksOfDataBetweenSheets()
Dim LR As Long, Rw As Long, Rw2 As Long
'Cut and Paste data into individual sheets
LR = Range("Q" & Rows.Count).End(xlUp).Row  'last row with data
Rw2 = 1
For Rw = 1 To LR Step 1                    'from the top down, compare

If Range("Q" & Rw).Value <> Range("Q" & Rw + 1).Value Then _
Sheets.Add After:=Sheets(Sheets.Count)
Range("A" & Rw2 & ":P" & Rw + 1).Copy
Sheets("Sheet" & Sheets.Count - 1).Select
Range("A3").Select
ActiveSheet.Paste

Sheets("VISIT HISTORY").Select
If Range("Q" & Rw).Value <> Range("Q" & Rw + 1).Value Then _
Rw2 = Rw + 1

Next Rw