我有以下代码:
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的范围,并为不同的名称创建工作表。然而,我无法弄清楚如何将每行的内容复制到每个创建的工作表中。
所以我希望将所有Ticker更改复制到新创建的工作表自动收报机更改中。
我知道有以下方法:
Range(Cells(rng, 1), Cells(rng, 10)).Copy
但我不知道如何将这些粘贴到不同的工作表中。 有人可以建议或指导。谢谢
此外,当我尝试运行此宏时,有时会说:
这个名字已经尝试了另一个。
但是没有具有该名称的工作表。
答案 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