Excel VBA从选定的行复制特定的单元格并将指定的列粘贴到其他工作簿

时间:2019-01-08 09:51:22

标签: excel vba copy paste

我有一个浮动按钮,当我选择了一些行并按下按钮时,我希望复制选定行中的某些指定单元格,然后将其粘贴到另一个工作簿中,该工作簿在按下按钮时会打开。

例如,选择了A列第2-3行中的值,当我按下按钮时,我希望将所选行中的A列中的值从第2行的开头复制到B列中。E列中的值复制到F列等。

我找到了以下代码,但找不到如何修改代码以指定要复制到哪个单元格的代码。

有人在那里给我一些提示吗?

Sub CopyCells()
    Dim Rng As Range
    For Each Rng In Selection.Areas
    Union(Rng.Resize(, 6), Rng.Resize(, 1).Offset(, 1)).Copy Sheets("Blad2").Cells(Rows.Count, 1).End(xlUp).Offset(1, 5)
    Next Rng
    Worksheets("Blad2").Activate
End Sub

新代码:

Public Sub CopyCells()
    Dim wsSrc As Worksheet 'define source sheet
    Set wsSrc = ThisWorkbook.Worksheets("Sheet1")

    Dim wsDest As Worksheet 'define destination sheet
    Dim wbDest As Workbook 'define destination workbook
    Set wbDest = Workbooks.Open("C:\Temp\Test.xlsx")
    Set wsDest = wbDest.Worksheets("Sheet1")

    Dim DestRow As Long
    DestRow = 2 'start in row 2 in destination sheet

    Dim Rng As Range
    For Each Rng In Selection.Areas
         Rng.Resize(, 1).Copy Destination:=wsDest.Cells(DestRow, "B") 'copy A to B
         Rng.Resize(, 1).Offset(, 4).Copy Destination:=wsDest.Cells(DestRow, "F") 'copy E to F
         DestRow = DestRow + Rng.Rows.Count 'move DestRow to next free row
    Next Rng
End Sub

1 个答案:

答案 0 :(得分:1)

如果列不是连续的,则需要为每个列执行复制操作。

Option Explicit

Public Sub CopyAtoBandEtoF()
    Dim wsSrc As Worksheet 'define source sheet
    Set wsSrc = ThisWorkbook.Worksheets("Source")

    Dim wsDest As Worksheet 'define destination sheet
    Set wsDest = ThisWorkbook.Worksheets("Destination")

    Dim DestRow As Long
    DestRow = 2 'start in row 2 in destination sheet

    Dim Rng As Range
    For Each Rng In Selection.Areas
        Rng.Resize(, 1).Copy Destination:=wsDest.Cells(DestRow, "B") 'copy A to B
        Rng.Resize(, 1).Offset(, 4).Copy Destination:=wsDest.Cells(DestRow, "F") 'copy E to F
        DestRow = DestRow + Rng.Rows.Count 'move DestRow to next free row
    Next Rng
End Sub