VBA复制整行List

时间:2015-10-26 10:14:16

标签: excel vba excel-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

这将通过A6到AXX的范围,并为不同的名称创建工作表。然而,我无法弄清楚如何将每行的内容复制到每个创建的工作表中。

enter image description here

所以我希望将所有Ticker更改复制到新创建的工作表自动收报机更改中。

我知道有以下方法:

   Range(Cells(rng, 1), Cells(rng, 10)).Copy

但我不知道如何将这些粘贴到不同的工作表中。 有人可以建议或指导。谢谢

此外,当我尝试运行此宏时,有时会说:

  

这个名字已经尝试了另一个。

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

1 个答案:

答案 0 :(得分:2)

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

试试这个(我已经包含了一个输入框来纠正工作表的名称,如果它已被采用:

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