使用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