使用VBA将动态范围复制并粘贴到Excel中的新工作表

Question

我是宏写作的新手，需要帮助。

我只有一张纸，需要复制这些列并重新排序以粘贴到软件程序中。

1. 我想复制A2-A列中的最后一个数据条目并将其粘贴到Sheet2的A1中
2. 我想复制B2-A列中的最后一个数据条目并将其粘贴到Sheet2的K1中
3. 我想复制C2-A列中的最后一个数据条目并将其粘贴到Sheet2的C1中
4. 我要复制D2-A列中的最后一个数据条目并将其粘贴到Sheet2的D1中
5. 然后从工作表2中，我要复制A1：KXXXX（到A列的最后一个条目）并将其保存在剪贴板上以粘贴到其他应用程序中

这是我的代码，我已经尝试过...（我知道这只是用于复制列A，但是我被卡在那里了。）

Sub Copy()
    aLastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    Range("A2" & aLastRow).Select
    Selection.Copy
    Sheets("Sheet2").Select
    Range("A1").Select
    ActiveSheet.Paste
End Sub

非常感谢你的帮助！ 枷锁

Answer 1

试试这个吧。 假设您说粘贴代码出错，而我仍在使用该代码，那么我认为您仍然会遇到错误。 发布错误消息。 希望我们能弄清楚。

Sub copyStuff()
    Dim wsIn As Worksheet
    Set wsIn = Application.Worksheets("Sheet1")

    Dim endRow As Long
    wsIn.Activate
    endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row

    Dim r As Range
    Dim wsOut As Worksheet
    Set wsOut = Application.Worksheets("Sheet2")

    ' column a to column a
    Set r = wsIn.Range(Cells(2, 1), Cells(endRow, 1))
    r.Copy
    wsOut.Range("A1").PasteSpecial xlPasteAll

    ' column b to column k
    Set r = wsIn.Range(Cells(2, 2), Cells(endRow, 2))
    r.Copy
    wsOut.Range("K1").PasteSpecial xlPasteAll

    ' column c to column c
    Set r = wsIn.Range(Cells(2, 3), Cells(endRow, 3))
    r.Copy
    wsOut.Range("C1").PasteSpecial xlPasteAll

    ' column d to column d
    Set r = wsIn.Range(Cells(2, 4), Cells(endRow, 4))
    r.Copy
    wsOut.Range("D1").PasteSpecial xlPasteAll

    ' Copy data from sheet 2 into clipboard
    wsOut.Activate
    Set r = wsOut.Range(Cells(1, 1), Cells(endRow - 1, 11))
    r.Copy

End Sub

我的原始答案在下面。 您可以忽略。

这应该可以实现您的第一个目标：

Sub copyStuff()
    Dim wsIn As Worksheet
    Set wsIn = Application.Worksheets("Sheet1")

    Dim endRow As Long
    endRow = wsIn.Cells(wsIn.Rows.Count, "A").End(xlUp).Row

    Dim r As range
    Set r = wsIn.range(Cells(2, 1), Cells(endRow, 4))
    r.Copy

    Dim wsOut As Worksheet
    Set wsOut = Application.Worksheets("Sheet2")

    wsOut.range("A1").PasteSpecial xlPasteAll

End Sub

我一次复制了所有4列，因为这样做会快得多，但是它假定这些列的长度相同。 如果不是这样，则需要一次复制一个。

数据应位于宏末尾的剪贴板中。

编辑：我删除了“ wsIn.Activate”，因为它并不是真正需要的。 编辑2：糟糕！ 我只是注意到您想要在不同的列中输出。 我会努力的。

Answer 2

通常，在复制值时要避免使用.Select和.Paste ，而是使用.value = .value复制：

Sub Copy()
    Dim aLastRow As Long
    Dim clipboard As MSForms.DataObject
    Set clipboard = New MSForms.DataObject

    aLastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Sheet2").Range("A1:A" & aLastRow - 1).Value = Sheets("Sheet1").Range("A2:A" & aLastRow).Value
    Sheets("Sheet2").Range("K1:K" & aLastRow - 1).Value = Sheets("Sheet1").Range("B2:B" & aLastRow).Value
    Sheets("Sheet2").Range("C1:D" & aLastRow - 1).Value = Sheets("Sheet1").Range("C2:D" & aLastRow).Value

    clipboard.SetText Sheets("Sheet2").Range("A1:K" & aLastRow - 1).Value
    clipboard.PutInClipboard
End Sub