Excel 2010 VBA transfer multicolumn Listbox to named range

Question

I've got a sub which I want to use to copy items from a multicolumn listbox to a named range on a spreadsheet. The part of the sub I'm having trouble with is commented as "Transfer to table" (below). It's not copying to my named range ("Import_Items" or "Export_Items", which reference certain tables depending on which sheet is being used as the source), and instead is copying to row 1 starting with column C. I feel like I'm probably missing something very simple, any help would be appreciated.

Sub Transfer()
Dim CopyToWB As Workbook
Dim ASName As String
Dim lItem As Long, lRows As Long, lCols As Long
Dim lColLoop As Long, lTransferRow As Long

Set CopyToWB = Workbooks.Open(FPath & "\" & FName)
ASName = ActiveSheet.Name
lRows = ItemsLB.ListCount - 1
lCols = ItemsLB.ColumnCount - 1

With CopyToWB.Sheets(ASName)
    Range(ASName & "_Date") = DateTB
    Range(ASName & "_Tool_Order") = ToolOrderTB
    Range(ASName & "_WAY_BILL") = TrackingTB
    Range(ASName & "_TPOC_Name") = TPOCNameTB
    Range(ASName & "_Site") = SiteTB
    Range(ASName & "_Street") = StreetTB
    Range(ASName & "_City_State") = CityStateTB
    Range(ASName & "_Zip") = ZipTB
    Range(ASName & "_SPOC_Name") = SPOCNameTB
    Range(ASName & "_SPOC_Phone") = PhoneTB
    Range(ASName & "_SPOC_Email") = SPOCEmailTB
    Range(ASName & "_TPOC_Email") = TPOCEmailTB


    'Transfer to table
    With Range(ASName & "_Items", ActiveSheet.Cells(lRows + 1, 4 + lCols)) 'Transfer to range
        For lItem = 0 To lRows
            'Increment variable for row transfer range
            lTransferRow = lTransferRow + 1
              'Loop through columns of selected row
              For lColLoop = 0 To lCols
                 'Transfer selected row to relevant row of transfer range
                 .Cells(lTransferRow, lColLoop + 1) = ItemsLB.List(lItem, lColLoop)
              Next lColLoop
        Next
    End With

    'Export/Import-dependent
    If ASName = "Export" Then
        Range(ASName & "_TPOC_Print_Name") = TPOCNameTB
        Range(ASName & "_TPOC_Title") = TPOCTitleTB
    ElseIf ASName = "Import" Then
        Range(ASName & "_Consignee_Name_Number") = TPOCNameTB & _
            " - " & TPOCPhoneTB
    End If

    Application.DisplayAlerts = False
    .SaveAs FPath & FName

    'Optional export to PDF
    If PDFChkBx = True Then
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=FPath & "Proforma Customs Invoice " & ToolOrderTB.Value & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=True
    End If

    Application.DisplayAlerts = True
End With

End Sub

Why loop rather than just dropping the List array into the sheet? — Rory
It's modified from a thread I found on OzGrid, I've been having trouble getting anything to copy to a table with other subs/userforms so I tried it this way. Can you give an example of what might be a better way to do it? — dubyarly

Rory Rory · Accepted Answer · 2016-06-02T14:01:41

This is how to drop the entire list into a range in one go:

With Me.ItemsLB
    Range(ASName & "_Items").Resize(.ListCount, .ColumnCount).Value = .List
End With

Here's an example to explicitly resize the table:

Dim lo As ListObject

With Me.ItemsLB
    Set lo = Range(ASName & "_Items").ListObject
    lo.Resize lo.Range.Resize(.ListCount + 1, .ColumnCount)
    lo.DataBodyRange.Value = .List
End With

Excel 2010 VBA transfer multicolumn Listbox to named range

1 Answers