使用VBA

时间:2017-02-23 15:46:18

标签: excel vba excel-vba

我是宏观写作的新手,我需要一些帮助。

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

  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列的最后一个条目)并将其保存在剪贴板上以粘贴到其他应用程序中
  6. 这是我的代码,我试过......(我知道这只是为了复制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
    

    非常感谢你的帮助! 杰斯

2 个答案:

答案 0 :(得分:2)

试试这个。鉴于你说你的粘贴代码有误,我仍在使用它,我想你还会有错误。发布错误消息。希望我们能解决这个问题。

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:哎呀!我刚刚注意到你想要输出不同的列。我会继续努力。

答案 1 :(得分: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