VBA - Copy multiple selections from a workbook and paste in another workbook

AV_Geek

New Member
Joined
Jan 23, 2022
Messages
32
Office Version
  1. 365
Platform
  1. MacOS
OK, I might be asking a lot on this one, but here it goes. I'm looking for a code that will:

1. Copy multiple pre-determined groups of cells from a workbook. The Ranges will be built into the code. You can use A20:D30 and F20:I30 when building the code.
2. Paste Values in a second workbook. (The source will be the results of a formula).
3. The destination workbook will be selected from a dropdown list of all open workbooks.
4. The user will also need to select the tab to paste the selection into. Obviously the list of tabs will be all tabs available in the selected workbook.
5. The paste ranges will be exactly the same as the copy ranges. Meaning, I will copy from A20:D30 and F20:I30 and paste into A20:D30 and F20:I30

Thanks in advance.
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
in a new workbook add 4 list boxes and 2 buttons into a worksheet named = Sheet3

the names used for these are in the code below - in the commented out first section

select the workbook and tab to copy from and the workbook and tab to copy to

no error checks in this code

the linked cells were just to display the selection in a cell of the worksheet they can be omitted from the list box properties


VBA Code:
'/**************************************************************************\


'ListBox_open_from
'this holds open excel workbooks
'linked cell = W3

'ListBox_open_from_tabs
'this holds the tabs from the selected workbook in ListBox_open_from
'linked cell = W16

'listbox_openexcel
'this holds open excel workbooks
'linked cell = E3

'ListBoxTabs
'this holds the tabs from the selected workbook in listbox_openexcel
'linked cell = E16


'button Refresh Open List
'name = CommandButton1
'refreshes both open workbook lists

'button Copy Range
'name = CommandButton2
'copies predefined range from selected from book and from tab
'into selected to book and to tab

'\**************************************************************************/


Private Sub CommandButton1_Click()
Call SelectWB
End Sub

Private Sub CommandButton2_Click()

Dim frombk As String, tobk As String, fromtab As String, totab  As String


'from workbook
'workbook(ListBox_open_from)

'from worksheet
'sheets(ListBox_open_from_tabs)

'to workbook
'workbook(ListBox_openexcel)

'to worksheet
'sheets(ListBoxTabs)


frombk = "" & Me.ListBox_open_from & ""
tobk = "" & Me.ListBox_openexcel & ""

fromtab = "" & Me.ListBox_open_from_tabs & ""
totab = "" & Me.ListBoxTabs & ""


'change the ranges below to suit your requirements

Workbooks(frombk).Worksheets(fromtab).Range("A2:D3").Copy Workbooks(tobk).Worksheets(totab).Range("A2")

Workbooks(tobk).Save

End Sub

Private Sub ListBox_open_from_Click()
'print the selection to the immediate window
'Debug.Print ListBox_open_from
addfromtabs (ListBox_open_from)
End Sub

Private Sub ListBox_open_from_tabs_Click()
'print the selection to the immediate window
'Debug.Print ListBox_open_from_tabs
End Sub

Private Sub ListBox_openexcel_Click()
'print the selection to the immediate window
'Debug.Print ListBox_openexcel
addtabs (ListBox_openexcel)
End Sub

Private Sub ListBoxTabs_Click()
'print the selection to the immediate window
'Debug.Print ListBoxTabs
End Sub

Sub SelectWB()
'call from workbook load event
    
    Dim xWb As Workbook
    ListBoxTabs.Visible = False
    ThisWorkbook.Sheets("Sheet1").ListBox_openexcel.Clear
    For Each xWb In Application.Workbooks
      If xWb.Name <> ThisWorkbook.Name Then ThisWorkbook.Sheets("Sheet1").ListBox_openexcel.AddItem xWb.Name
    Next
    
    ThisWorkbook.Sheets("Sheet1").ListBox_open_from.Clear
    For Each xWb In Application.Workbooks
      If xWb.Name <> ThisWorkbook.Name Then ThisWorkbook.Sheets("Sheet1").ListBox_open_from.AddItem xWb.Name
    Next
    
    If ListBox_openexcel.ListCount > 0 Then ListBox_openexcel.ListIndex = 0
    If ListBox_open_from.ListCount > 0 Then ListBox_open_from.ListIndex = 0
    
End Sub

Sub addtabs(bookname As String)
Dim sht As Worksheet
ListBoxTabs.Clear
For Each sht In Workbooks(bookname).Sheets
ListBoxTabs.AddItem sht.Name
Next sht
If ListBoxTabs.ListCount > 0 Then ListBoxTabs.ListIndex = 0
ListBoxTabs.Visible = True
End Sub

Sub addfromtabs(bookname As String)
Dim sht As Worksheet
ListBox_open_from_tabs.Clear
For Each sht In Workbooks(bookname).Sheets
ListBox_open_from_tabs.AddItem sht.Name
Next sht
If ListBox_open_from_tabs.ListCount > 0 Then ListBox_open_from_tabs.ListIndex = 0
ListBox_open_from_tabs.Visible = True
End Sub
 
Upvote 0
So I finally got to try this and I got part way there, but am having a few issues.

1. Correct me if I'm wrong, but I wanted to use ActiveX Controls, correct? I used them and assigned the name from the dropdown at the top of the Properties Window. Also, the code is placed into Sheet3, not a module.

2. in CommandButton1, I'm getting an error every time I use it. I'm getting an error:

Runtime Error '438': Object doesn't support this property of method. Also, the debugger is stopping at

VBA Code:
Sub SelectWB()
'call from workbook load event
    
    Dim xWb As Workbook
    ListBoxTabs.Visible = False
   [COLOR=rgb(247, 218, 100)] [/COLOR][COLOR=rgb(184, 49, 47)]ThisWorkbook.Sheets("Sheet1").ListBox_openexcel.Clear[/COLOR]
    For Each xWb In Application.Workbooks
      If xWb.Name <> ThisWorkbook.Name Then ThisWorkbook.Sheets("Sheet1").ListBox_openexcel.AddItem xWb.Name
    Next
    
    ThisWorkbook.Sheets("Sheet1").ListBox_open_from.Clear
    For Each xWb In Application.Workbooks
      If xWb.Name <> ThisWorkbook.Name Then ThisWorkbook.Sheets("Sheet1").ListBox_open_from.AddItem xWb.Name
    Next
    
    If ListBox_openexcel.ListCount > 0 Then ListBox_openexcel.ListIndex = 0
    If ListBox_open_from.ListCount > 0 Then ListBox_open_from.ListIndex = 0
    
End Sub

3. When I paste, I want to Paste Values. I had it working earlier and it was simply pasting.

4. Just out of curiosity, why does this need to be on Sheet3? Why can't it be on Sheet 1? Or better yet, can it be put into the source or destination workbooks?
 
Upvote 0
sorry looks like I said sheet3 but the code is looking at sheet1


which sheet holds the listboxes?

the below expects the listboxes in Sheet1 - you need to change this to the sheet name / number your using

ThisWorkbook.Sheets("Sheet1").ListBox_openexcel.Clear
 
Upvote 0
OK, I made some good progress. TYVM!!!!!!

However, it's still going a general copy and paste, I need it to Paste Values. It's pasting the formula from my source into my destination. I need it to past the result of the formula into the destination.

For example, Source cell A5 = if(A1>4,"A","B") I want the destination cell to show "A" or "B"

Also, can the code be modified to insert into a new tab in the workbook I'm copying from? Sheet Number "Sheet1", Sheet Name "Buttons"
 
Upvote 0
OK, I did some finagling and have everything set up to run from one book. If anyone can please convert the below code to Paste Values, rather than simply copy and paste, my project should be complete. Note that this is the actual code from my project, modified from the sample provided..

VBA Code:
'/**************************************************************************\





'ListBox_open_from
'this holds open excel workbooks
'linked cell = W3

'ListBox_open_from_tabs
'this holds the tabs from the selected workbook in ListBox_open_from
'linked cell = W16

'listbox_openexcel
'this holds open excel workbooks
'linked cell = E3

'ListBoxTabs
'this holds the tabs from the selected workbook in listbox_openexcel
'linked cell = E16

'button Refresh Open List
'name = CommandButton1
'refreshes both open workbook lists

'button Copy Range
'name = CommandButton2
'copies predefined range from selected from book and from tab
'into selected to book and to tab



'\**************************************************************************/


Private Sub CommandButton1_Click()
Call SelectWB
End Sub

Private Sub CommandButton2_Click()
Dim frombk As String, tobk As String, fromtab As String, totab As String
'from workbook
'workbook(ListBox_open_from)
'from worksheet
'sheets(ListBox_open_from_tabs)
'to workbook
'workbook(ListBox_openexcel)
'to worksheet
'sheets(ListBoxTabs)

frombk = "COTP"
tobk = "COTP"
fromtab = "COTP"
totab = "" & Me.ListBoxTabs & ""

'change the ranges below to suit your requirements

Worksheets("COTP").Range("Y75:AC85").Copy Worksheets(totab).Range("C75")
Worksheets("COTP").Range("AI75:AM85").Copy Worksheets(totab).Range("M75")
Worksheets("COTP").Range("Z94:AL108").Copy Worksheets(totab).Range("D94")
Worksheets("COTP").Range("Z111:AL124").Copy Worksheets(totab).Range("D111")
Worksheets("COTP").Range("X149:AN175").Copy Worksheets(totab).Range("B149")
Worksheets("COTP").Range("X179:AN203").Copy Worksheets(totab).Range("B179")


Worksheets("COTP").Range("Y225:AC234").Copy Worksheets(totab).Range("C225")
Worksheets("COTP").Range("AI225:AM237").Copy Worksheets(totab).Range("M225")
Worksheets("COTP").Range("Z243:AK251").Copy Worksheets(totab).Range("D243")
Worksheets("COTP").Range("Z254:AK262").Copy Worksheets(totab).Range("D254")
Worksheets("COTP").Range("X297:AN329").Copy Worksheets(totab).Range("B297")
Worksheets("COTP").Range("X333:AN363").Copy Worksheets(totab).Range("B333")


Worksheets("COTP").Range("X375:AN405").Copy Worksheets(totab).Range("B375")
Worksheets("COTP").Range("X409:AN439").Copy Worksheets(totab).Range("B409")


Workbooks(tobk).Save

End Sub


Private Sub ListBox_open_from_Click()
'print the selection to the immediate window
'Debug.Print ListBox_open_from
addfromtabs (ListBox_open_from)
End Sub

Private Sub ListBox_open_from_tabs_Click()
'print the selection to the immediate window
'Debug.Print ListBox_open_from_tabs
End Sub

Private Sub ListBox_openexcel_Click()
'print the selection to the immediate window
'Debug.Print ListBox_openexcel
addtabs (ListBox_openexcel)
End Sub

Private Sub ListBoxTabs_Click()
'print the selection to the immediate window
'Debug.Print ListBoxTabs
End Sub

Sub SelectWB()
'call from workbook load event

Dim xWb As Workbook
Dim sht As Worksheet
ListBoxTabs.Visible = True
ThisWorkbook.Sheets("COTP").ListBoxTabs.Clear
For Each sht In ThisWorkbook.Sheets
ThisWorkbook.Sheets("COTP").ListBoxTabs.AddItem sht.Name
Next

If ListBox_openexcel.ListCount > 0 Then ListBox_openexcel.ListIndex = 0
If ListBox_open_from.ListCount > 0 Then ListBox_open_from.ListIndex = 0

End Sub


Sub addtabs(bookname As String)
Dim sht As Worksheet
ListBoxTabs.Clear
For Each sht In Workbooks(COTP).Sheets
ListBoxTabs.AddItem sht.Name
Next sht
If ListBoxTabs.ListCount > 0 Then ListBoxTabs.ListIndex = 0
ListBoxTabs.Visible = True
End Sub


Sub addfromtabs(bookname As String)
Dim sht As Worksheet
ListBox_open_from_tabs.Clear
For Each sht In Workbooks(bookname).Sheets
ListBox_open_from_tabs.AddItem sht.Name
Next sht
If ListBox_open_from_tabs.ListCount > 0 Then ListBox_open_from_tabs.ListIndex = 0
ListBox_open_from_tabs.Visible = True
End Sub
 
Last edited:
Upvote 0
you could set it up to copy values but will need to define the destination range

ws.Range("G1:I12").Value = source
ws.Range("M1:O12").Value = destination

ws.Range("M1:O12").Value = ws.Range("G1:I12").Value

so from 1 of your lines
Worksheets("COTP").Range("X375:AN405").Copy Worksheets(totab).Range("B375")

should be changed to
Worksheets(totab).Range("B375:R405").value = Worksheets("COTP").Range("X375:AN405").value
 
Upvote 0

Forum statistics

Threads
1,215,106
Messages
6,123,120
Members
449,096
Latest member
provoking

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top