根据一个列值的值将一个工作表中具有不同行数的范围拆分为单独的工作表

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