Excel VBA скопирует определенные ячейки из выбранных строк и вставит указанный столбец в другую книгу

Question

У меня есть плавающая кнопка, которая, когда я выделил несколько строк и нажал кнопку, я хочу, чтобы некоторые указанные ячейки из выбранных строк были скопированы, а затем вставлены в другую рабочую книгу, которая открывается при нажатии кнопки.

Например, значение в строках 2-3 столбца A выбрано, и когда я нажимаю кнопку, я хочу, чтобы значения в столбце A из выбранных строк были скопированы в столбец B с начала строки 2. Значения в столбце 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

Answer 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