Excel VBA 在一列中重复复制和粘贴一系列单元格

Question

我尝试了两种不同的方法。

首先，select 要复制的单元格范围，select 要粘贴的目标范围。下面是代码：

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() 等，您应该 always显式 sheet 你期望运行那个。

其次，您要避免使用 .Select，正如我在评论中所链接的那样。实际上，您只是 "back up" 以 .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() 之前包含 sheet 名称。

Excel VBA 在一列中重复复制和粘贴一系列单元格

Excel VBA Copy & Paste a Range of Cells Repeatedly in a Column

excel

vba

copy-paste