CODEWITHSUNDEEP
excelvbalistbox
Ernesto
Ernesto

Reputation: 173

Copying multiple rows/colums from ListBox to excel sheet

I need a serious help. The code below works out of the box for one simple ListBox but the problem is that my listbox has 7 column that I need to copy to excel. I know that the solution is probably easy but I have no idea how to modify it to make it work. Right now is copying the first column only

Private Sub CopyButton_Click()

Dim i As Long
Dim ary


    ReDim ary(0 To 0)

    With Me.ListBox2
    For i = 0 To .ListCount - 1
        If .Selected(i) Then

            ReDim Preserve ary(1 To UBound(ary) + 1)

            ary(UBound(ary)) = .List(i)
        End If
    Next
    End With


    Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(ary)).Value _
    = Application.Transpose(ary)


End Sub

Upvotes: 0

Views: 576

Answers (1)

user6432984
user6432984

Reputation:

The ListBox List Property returns an array all of the values in the ListBox. 

With Me.ListBox2
    Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(.ListCount, .ColumnCount).Value = .List
End With

The easiest way to copy the Selected items into an Array is to:

  1. Loop through the items
  2. Dimension the Array to fit
  3. Make a second loop filling the Array

This will prevent you from having to Transpose the Array.

Private Sub CopyButton_Click()
    Dim i As Long, j As Long, count As Long
    Dim ary As Variant

    With Me.ListBox2
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                count = count + 1
            End If
        Next
        ReDim ary(1 To count, 1 To .ColumnCount)
        count = 0
        For i = 0 To .ListCount - 1
            If .Selected(i) Then
                count = count + 1
                For j = 0 To .ColumnCount - 1
                    ary(count, j + 1) = .List(i, j)
                Next
            End If
        Next
    End With

    Cells(Rows.count, "A").End(xlUp).Offset(1).Resize(UBound(ary, 1), UBound(ary, 2)).Value = ary

End Sub

Upvotes: 1

Related Questions