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结尾的两行.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()之前包括工作表名称。