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

Question

I am new to macro writing and I need some help.

I have one sheet and need to copy the columns and reorder them to paste into a software program.

1. I want to copy A2 - the last data entry in column A and paste it into A1 on Sheet2
2. I want to copy B2 - the last data entry in column A and paste it into K1 on Sheet2
3. I want to copy C2 - the last data entry in column A and paste it into C1 on Sheet2
4. I want to copy D2 - the last data entry in column A and paste it into D1 on Sheet2
5. Then from Sheet 2, I want to copy A1:KXXXX (to the last entry in column A) and save it on the clipboard to paste into the other application

Here is my code, I have tried... (I know this is just for copying column A, but I got stuck there.)

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

Thank you so much for your help! Jess

Answer 1

Try this instead. Given that you said you got an error with the paste code and I am still using that, I think you'll still have an error there. Post the error message. Hopefully we can figure that out.

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

My original answer is below here. You can disregard.

This should accomplish your first goal:

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

I copied all 4 columns at once since that would be much faster but it assumes the columns are the same length. If that isn't true you would need to copy one at a time.

The data should be in the clipboard at the end of the macro.

Edit: I removed "wsIn.Activate" since it isn't really needed. Edit 2: Oops! I just noticed you wanted the output in different columns. I'll work on it.

Answer 2

Generally you want to avoid .Select and .Paste when copying values and rather copy by .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