Excel VBA在列中反覆地複製並粘貼一系列單元格

Question

我以兩種不同的方式嘗試了這種方法。

首先，選擇要複製的單元格範圍，然後選擇要粘貼的目標範圍。以下是代碼：

Sub PanelData() 

Dim size As Integer 
Dim i As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 


Set shrate = Sheets("Rate") 
Set shpanel = Sheets("Panel") 

size = shrate.Range("B4").End(xlDown).Row 

shrate.Range(Cells(4, 2), Cells(size, 2)).Select 
Selection.Copy 

shpanel.Cells(1, 1).Value = size - 3 

For i = 1 To 18 

shpanel.Range(Cells(4, 1).Offset((i - 1) * (size - 3), 0), Cells(3, 1).Offset(i * (size - 3), 0)).Select 
     Selection.PasteSpecial Paste:=xlPasteValues 
     Selection.NumberFormat = "m/d/yyyy" 

Next i 

End Sub 

其次，複製範圍內的單元格，然後逐個粘貼到目標列。這裏是代碼：

Sub LoopingCP() 
Dim size As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 

Set shrate = Sheets(2) 
Set shpanel = Sheets(4) 

size = shrate.Cells(4, 2).End(xlDown).Row - 3 

For x = 1 To 18 

    For i = 1 To size 
     shrate.Cells(i + 3, 2).Select 
      Selection.Copy 

     shpanel.Cells(x * (i + 3), 1).Select 
      Selection.PasteSpecial Paste:=xlPasteValues 
      Selection.NumberFormat = "m/d/yyyy" 

    Next i 

Next x 
End Sub 

這些嘗試都沒有解決。我做錯了什麼？

謝謝

Answer 1

一些事情阻止了它的工作。首先，當使用Range變量時，例如Range(),Cells(),Rows(),Columns()等，您應該始終使用明確表示您希望運行該表。

其次，你想避免使用.Select，因爲我在評論中鏈接到。實際上，你只是「備份」的兩行結束，且開始，.Select/.Selection

見，如果這個工程：

Sub PanelData() 

Dim size As Integer 
Dim i As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 


Set shrate = Sheets("Rate") 
Set shpanel = Sheets("Panel") 

size = shrate.Range("B4").End(xlDown).Row 

shrate.Range(shrate.Cells(4, 2), shrate.Cells(size, 2)).Copy 

shpanel.Cells(1, 1).Value = size - 3 

For i = 1 To 18 
    With shpanel.Range(shpanel.Cells(4, 1).Offset((i - 1) * (size - 3), 0), shpanel.Cells(3, 1).Offset(i * (size - 3), 0)) 
     .PasteSpecial Paste:=xlPasteValues 
     .NumberFormat = "m/d/yyyy" 
    End With 
Next i 

End Sub 

Sub LoopingCP() 
Dim size As Integer 
Dim shrate As Worksheet 
Dim shpanel As Worksheet 

Set shrate = Sheets(2) 
Set shpanel = Sheets(4) 

size = shrate.Cells(4, 2).End(xlDown).Row - 3 

For x = 1 To 18 
    For i = 1 To size 
     shrate.Cells(i + 3, 2).Copy 
     With shpanel.Cells(x * (i + 3), 1) 
      .PasteSpecial Paste:=xlPasteValues 
      .NumberFormat = "m/d/yyyy" 
     End With 
    Next i 
Next x 
End Sub 

僅供參考 - 當你只是想要的值，你可以設置範圍值，而不是使用.Copy/.Paste，從而節省從正在使用的剪貼板，並保存在運行宏時一點時間等於海誓山盟，：

Range([destination range]).Value = Range([copy from range]).Value（並請注意，您需要包括Range()之前的紙張名當然，