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

debugcn 发表于 Dev

马库斯萨克拉门托

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

例如，选择 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

Pᴇʜ

如果列不连续，您需要对每一列进行复制操作。

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

本文收集自互联网，转载请注明来源。

如有侵权，请联系[email protected] 删除。