VBA复制列表的整行

我有以下代码：

Sub test()
Dim r As Range, rng As Range
Set r = Range("a6", Range("a6").End(xlDown))
    For Each rng In r
        If rng <> rng.Offset(-1) Then 'if range is not
            Dim ws As Worksheet
            Set ws = Worksheets.Add
            ws.Name = rng
        Else
        End If
    Next rng
End Sub

但我不知道如何将它们粘贴到不同的工作表上。 有人能给我建议或指导吗。谢谢

此外，当我尝试运行此宏时，它有时会说：

该名称已被使用，请尝试其他名称

---

但是，没有具有该名称的工作表。

您只需要引用/指定要使用的工作表

尝试此操作（我包括了一个输入框，用于更正工作表的名称，如果已经使用了：

Sub test_Nant()
Dim r As Range, rng As Range, ws As Worksheet, aWs As Worksheet
Set aWs = ActiveSheet
Set ws = Worksheets.Add
            On Error GoTo SheetRename
            ws.Name = "Changes list"
            GoTo KeepLooping
SheetRename:
            ws.Name = InputBox("Choose another name for that sheet : ", , rng.Value)
            Resume Next
KeepLooping:
With aWs
    Set r = .Range(.Range("a6"), .Range("a6").End(xlDown))
    For Each rng In r
        If rng <> rng.Offset(-1) Then 'if range is not
            .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 10)).Copy Destination:=ws.Range("A1")
        Else
        End If
    Next rng
End With
End Sub

子测试
尺寸r作为范围、rng作为范围、ws作为工作表、aWs作为工作表
设置aWs=ActiveSheet
设置ws=工作表。添加
关于错误转到SheetRename
ws.Name=“更改列表”
后藤
表单重命名：
ws.Name=InputBox（“为该工作表选择另一个名称：”，rng.Value）
下一步继续
继续：
与aWs
设置r=.Range（.Range（“a6”），.Range（“a6”）.End（xlDown））
对于r中的每个rng
如果rng rng.Offset（-1），则“如果范围不在
.Range（.Cells（rng.Row，1），.Cells（rng.Row，10））。复制目标：=ws.Range（“A1”）
其他的
如果结束
下一个rng
以
端接头

Hi，首先非常感谢您的快速响应。唯一的问题是它只会复制1项，比如清单更改。我希望将该范围内的所有清单更改项目复制到清单更改选项卡中。我需要如何为此扩展此代码？您最初的要求是创建一个表/tab对于每个更改…尝试编辑@Nant

Sub test_Nant()
Dim r As Range, rng As Range, ws As Worksheet, aWs As Worksheet
Set aWs = ActiveSheet
Set ws = Worksheets.Add
            On Error GoTo SheetRename
            ws.Name = "Changes list"
            GoTo KeepLooping
SheetRename:
            ws.Name = InputBox("Choose another name for that sheet : ", , rng.Value)
            Resume Next
KeepLooping:
With aWs
    Set r = .Range(.Range("a6"), .Range("a6").End(xlDown))
    For Each rng In r
        If rng <> rng.Offset(-1) Then 'if range is not
            .Range(.Cells(rng.Row, 1), .Cells(rng.Row, 10)).Copy Destination:=ws.Range("A1")
        Else
        End If
    Next rng
End With
End Sub