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()之前包括工作表名稱。