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

[GTO]

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