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()之前的纸张名当然，