Excel 根据“一列”值将一张图纸中具有不同行数的范围拆分为单独的图纸

我试图将工作表（“访问历史”）中的数据拆分为同一本书中不同数量的工作表，这些工作表是创建和分配的标准Excel名称（Sheet1、Sheet2……SheetX）其中，纸张数量由列Q中唯一值的数量决定。Q是主要排序列，因此数据的结构使所有唯一值都在一起

我已经创建了下面的子程序，它只将访问历史记录上单元格

Q2

中的值复制到每个后续工作表上的

A3

。它的工作原理几乎是将数据复制到每张工作表的正确起始字段中，但数据不正确，而且似乎没有复制或写入正确的数据范围。我需要的数据是Q相同的行块，包括A到P列

当我逐步进入调试模式时，似乎变量

LR

、

Rw

和

Rw2

存储了正确的值，以使

范围（“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

图纸之间数据的子剪切和粘贴块（）
变暗LR为长，Rw为长，Rw2为长
LR=范围（“Q”和Rows.Count）。结束（xlUp）。行的最后一行包含数据
Rw2=2
对于Rw=2至LR步骤1’，自上而下，比较
出错时继续下一步
如果范围（“Q”和Rw）.值范围（“Q”和Rw+1）.值，则_
Sheets.Add After:=工作表（Sheets.Count）
表1.选择
范围（“A&Rw2:P&Rw”）。选择
Application.CutCopyMode=False
选择，复制
工作表（“工作表”&工作表.计数-1）.选择
范围（“A3”）。选择
Selection.Paste特殊粘贴：=xlPasteColumnWidths，操作：=xlNone_
SkipBlanks:=False，转置：=False
活动表。粘贴
工作表（“访问历史”）。选择
如果范围（“Q”和Rw）.值范围（“Q”和Rw+1）.值，则_
Rw2=Rw+1
下一个Rw
端接头

这个评论为我指明了正确的方向——谢谢。对于任何可能感兴趣的人，工作代码如下所示：

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

图纸之间数据的子剪切和粘贴块（）
变暗LR为长，Rw为长，Rw2为长
'将数据剪切并粘贴到各个图纸中
LR=范围（“Q”和Rows.Count）。结束（xlUp）。行的最后一行包含数据
Rw2=1
对于Rw=1至LR步骤1’，自上而下比较
如果范围（“Q”和Rw）.值范围（“Q”和Rw+1）.值，则_
Sheets.Add After:=工作表（Sheets.Count）
范围（“A”&Rw2&“：P”&Rw+1）。复制
工作表（“工作表”&工作表.计数-1）.选择
范围（“A3”）。选择
活动表。粘贴
工作表（“访问历史”）。选择
如果范围（“Q”和Rw）.值范围（“Q”和Rw+1）.值，则_
Rw2=Rw+1
下一个Rw

有很多事情1）在错误恢复时删除

下一步

2）您将看到代码在

范围（“A&Rw2:P&Rw”）上失败。选择

，因为

“A&Rw2:P&Rw”是一个字符串。我猜你是在尝试这个<代码>范围（“A”&Rw2&“：P”&Rw）

3）避免

。选择
。直接执行相关操作。仅供参考，我将在VBA中删除您的复制/粘贴，尤其是在您仅获取值的情况下。相反，尝试
Range（“A3:P”&Rw+4）。value=Range（“A”&Rw2&“：P”&Rw+1）。将原始+1偏移量的值“+4”添加到3的起始行
有很多事情1）删除
错误恢复下一步
2）您将看到
Range（“A&Rw2:P&Rw”）上的代码失败。选择
，因为
“A&Rw2:P&Rw”
是一个字符串。我猜你是在尝试这个<代码>范围（“A”&Rw2&“：P”&Rw）
3）避免
。选择
。直接执行相关操作。仅供参考，我将在VBA中删除您的复制/粘贴，尤其是在您仅获取值的情况下。相反，尝试
Range（“A3:P”&Rw+4）。value=Range（“A”&Rw2&“：P”&Rw+1）。将原始+1偏移量的值“+4”添加到3的起始行