根据一列值的不同，将一张​​纸中的不同行数分割成单独的纸张

我试图将表格中的数据（“访问历史”）分成不同数量的工作表，在同一本书中创build和分配标准的Excel名称（Sheet1，Sheet2 …… SheetX）由列Q中唯一值的数量决定。Q是主sorting列，因此数据是结构化的，因此所有唯一值都在一起。

我已经创build了下面的子例程，它仅将VISIT HISTORY上的单元格Q2的值复制到每个后续工作表中的A3上。 它几乎可以工作，它将数据复制到每张纸的正确起始字段，但是数据不正确，似乎不能复制或写入正确的数据范围。 我需要的数据是Q行相同的行块，包括A到P列。

当我通过debugging模式时，看起来好像variablesLR ， Rw和Rw2有正确的值来存储Range("A & Rw2:P & Rw").Select命令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