VBA複製列表

Question

的整行，我有以下代碼：

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的範圍，併爲不同名稱的工作表。然而，我不知道如何將每一行的內容複製到每個創建的工作表中。

所以我希望所有的變化新浪體育訊北京時間被複制到新創建的工作表中股票的變化。

我知道有一些方法有以下：

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

但我不知道怎麼粘貼這些不同的工作表。 有人可以請教或指導。由於

還當我嘗試運行此宏有時說：

這名已被嘗試不同的一個。

但是，沒有該名稱的工作表。

Answer 1

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

試試這個（我包括一個輸入框糾正表的名稱，如果它已被佔用。

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