Userform-Listbox, Copying and Pasting form one workbook to another

First time poster but have used the forum to help me many times. I couldn't find anything previously posted that fits my particular problem:

I have a userform which brings up 2 list boxes. The list boxes show all open workbooks. Here is my code:

[vba]Private Sub UserForm_Activate()
'Populate list box with names of open workbooks.
Dim wb As Workbook
For Each wb In Workbooks
ListBox1.AddItem wb.Name
ListBox2.AddItem wb.Name
Next wb
End Sub[/vba]
I want to add a button to my userform which will call a macro which does the following:

1) Copies the following range from the Listbox1 selection workbook:

'The worksheet name is "Sales Details"
Range("A9").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

2) Pastes that selection (with formatting) to the end of the Listbox2 selection workbook:

'The worksheet name is also "Sales Details"
The pasted values should start in the first row with no value in Column A (i achieve this by
selecting "A9", ctrl+down

Also, is there a way to select multiple workbooks in Listbox1 and paste the selections in each of those workbooks to the end of the Listbox2 selected workbook.

I'm not even sure if this is possible. Anyone have any ideas?

Thanks,

Brian

Hi Brian,

AFAIK, a list box in excel doesn't allow multiple values to be selected, so I don't think you'll be able to do the whole multiple source selection.

Quote:

---

Originally Posted by draco664

Hi Brian,

AFAIK, a list box in excel doesn't allow multiple values to be selected, so I don't think you'll be able to do the whole multiple source selection.

---

Alright, that's no biggie. How would i refer to a range from another workbook using the selections in a listbox?

Greetings Brian,

I see that you just joined. Welcome to vbaexpress! I'm sure that you'll be glad you joined. I read threads for quite some time before joining as well, and after joining, always wonder why I waited. I've 'met' some really good folks here and find that as enjoyable as the learning.

Well, as to your question, you can set a listbox to allow multiple selections. In reading your first post, I was a little unsure as to having all the workbooks listed in the listbox where we want to select the destination. Regardless, I wrote the example that way, so you'll see that the code would be run from a non-involved wb.

The example is a little rough, but hopefully it will get you started.

As mentioned, example wb's are zipped, but here's the code to the userform:
[vba]Option Explicit

Private Sub cmdCopyRange_Click()
Dim i As Long
Dim arySources
Dim wb As Workbook, wbDest As Workbook
Dim wks As Worksheet, wksDest As Worksheet
Dim rng As Range, rngDest As Range

Const SHEET_NAME As String = "Sales Details" '~Change to suit~

'// Initially resize our array. We will bump the bottom up in the loop, to keep //
'// the array correctly sized. //
ReDim arySources(0 To 0)

'// Loop through the source workbook listbox, adding the selected wb's to our array //
For i = 0 To lstSource.ListCount - 1
If lstSource.Selected(i) Then
'// Make room in the array for another value //
ReDim Preserve arySources(1 To UBound(arySources) + 1)
arySources(UBound(arySources)) = lstSource.List(i, 0)
End If
Next

'// Loop through the values we stored in our array. //
For i = LBound(arySources) To UBound(arySources)
'// Overkill, but to prevent (handled before here down below) copying from/to //
'// the destination wb. //
If Not lstDestination.List(lstDestination.ListIndex, 0) = arySources(i) Then
'// Set a reference to the source wb //
Set wb = Workbooks(arySources(i))

'// Just in case sheet is mis-named or other fluke //
On Error Resume Next
Set wks = Nothing: Set rng = Nothing
Set wks = wb.Worksheets(SHEET_NAME)
If Err Then
MsgBox "Error finding sheet", vbCritical, ""
Unload Me
End If
With wks
'// Presumes source data in Col A, from row 2 and downward. //
Set rng = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
If Err Then
MsgBox "Error finding range", vbCritical, ""
Unload Me
End If
End With
Set wb = Workbooks(lstDestination.List(lstDestination.ListIndex, 0))
Set wksDest = wb.Worksheets(SHEET_NAME)
'// Set a reference in the destination sheet to one cell below where data //
'// is found //
With wksDest
Set rngDest = .Cells(.Rows.Count, 1).End(xlUp).Offset(1)
End With
If Err Then
MsgBox "Unable to locate destination workbook, worksheet, or range", vbCritical, ""
Unload Me
End If
On Error GoTo 0

rng.Copy rngDest
End If
Next
End Sub

Private Sub cmdUnload_Click()
Unload Me
End Sub

Private Sub lstSource_Change()
Static bolInProcess As Boolean
'// Prevent recurse //
If Not bolInProcess Then
'// Before checking, see if the destination listbox has a value sleected. //
If Not lstDestination.ListIndex = -1 Then
'// If user attempts to select a source that matches what is selected in //
'// destination listbox, stop him. //
If lstSource.List(lstSource.ListIndex, 0) = lstDestination.List(lstDestination.ListIndex, 0) Then
bolInProcess = True
lstSource.Selected(lstSource.ListIndex) = False
MsgBox "You're hurting my brain. You cannot select the book " & _
"already picked as the destination as a source also..."
bolInProcess = False
End If
End If
'// See function - keep command button disabled until at least one source wb and//
'// the destination wb are both selected. //
cmdCopyRange.Enabled = ItemsSelected
End If
End Sub

Private Sub lstDestination_AfterUpdate()
Static bolProcessing As Boolean
Dim i As Long
'// SAA //
If Not bolProcessing Then
For i = 0 To lstSource.ListCount - 1
If lstSource.Selected(i) And Not lstDestination.ListIndex = -1 Then

If lstSource.List(i, 0) = lstDestination.Value Then

bolProcessing = True
'// I found that I had to set the focus elsewheres to set the //
'// ListIndex to -1 ??? //
lstSource.SetFocus
lstDestination.ListIndex = -1
DoEvents
MsgBox "Again with the brain killin'"

GoTo Bailout
End If
End If
Next
Bailout:
cmdCopyRange.Enabled = ItemsSelected
bolProcessing = False
End If
End Sub

'// Return whether at least one item is selected in the source listbox AND an item is //
'// selected in the destination listbox //
Private Function ItemsSelected() As Boolean
Dim i As Long

For i = 0 To lstSource.ListCount - 1
If lstSource.Selected(i) Then
If lstDestination.ListIndex <> -1 Then
ItemsSelected = True
Exit Function
End If
End If
Next
End Function

Private Sub UserForm_Initialize()
Dim wb As Workbook

With Me
With .Label1
.Caption = "Source WB's"
.Height = 9.75
.Left = 31.5
.Top = 6
.Width = 45
End With
With .Label2
.Caption = "Destination WB's"
.Height = 9.75
.Left = 137.6
.Top = 6
.Width = 60.75
End With
With .lstSource
.ColumnCount = 1
'.ColumnWidths = "96 pt;0 pt"
.Height = 120
.Left = 6
.MultiSelect = fmMultiSelectExtended
.Top = 16
.Width = 96
End With
With .lstDestination
.ColumnCount = 1
'.ColumnWidths = "96 pt; 0 pt"
.Height = 120
.Left = 120
.MultiSelect = fmMultiSelectSingle
.Top = 16
.Width = 96
End With
With .cmdCopyRange
.Caption = "Copy Range(s)"
.Height = 22
.Left = 18
.Top = 150
.Width = 72
.Enabled = False
End With
With .cmdUnload
.Caption = "Unload Form"
.Height = 22
.Left = 132
.Top = 150
.Width = 72
End With
End With

For Each wb In Workbooks
If wb.FullName <> ThisWorkbook.FullName Then
lstSource.AddItem wb.Name
'lstSource.List(lstSource.ListCount - 1, 1) = wb.FullName
lstDestination.AddItem wb.Name
'lstDestination.List(lstDestination.ListCount - 1, 1) = wb.FullName
End If
Next
End Sub[/vba]

Hope that helps,

Mark

GTO,

Oh my! You out did yourself. This will definitely give me enough to play around with for a while. I will let you know if I have any questions.

Thanks,

Brian.

GTO, your solution works like absolute gold! Thank you so much! One small issue:

I changed the source data range to copy columns (A:AN). There are about 7 named ranges within the source data which are identical on both the source and destination worksheets. When the macro pastes to the destination, it Excel asks if I want to move or copy the name 'NamedRange', which already exists on the destination worksheet, to use this version of the name. However, it asks this question 7 times for each named range. Is there a way I can bypass the message boxes and have the default answer be "Yes"?

I have attached the message that I would like to bypass. I would like the answer to be "Yes" but i do not want the user to see this message pop up.

-Brian

Hi Brian,

Sorry, but must log out. Will look to see tonight, if not already answered.

Mark

if you are sure you want to bypass Name Conflict Dialog Box you may try..

[vba]

Application.DisplayAlerts = False
'code
'code
Application.DisplayAlerts = True[/vba]