CODEWITHSUNDEEP
excelvbacopypaste
Markus Sacramento
Markus Sacramento

Reputation: 364

Copy specific cells from selected rows and paste specified column other workbook

I have a floating button which when I have selected some rows and presses the button I want some specified cells from the selected rows to be copied and then pasted into a other workbook which opens when button is pressed.

For example the value in Column A rows 2-3 is selected and when I press the button I want the values in column A from the selected rows to be copied to column B from start of row 2. The values in column E to be copied to column F etc.

I have found following code but I can't find out how to modify the code to specify what cells to copy to where.

Anyone out there to give me some hints?

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

New code:

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

Upvotes: 1

Views: 3388

Answers (1)

Pᴇʜ
Pᴇʜ

Reputation: 57683

You need a copy action for each column if the columns are not continous.

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

Upvotes: 2

Related Questions