Excel 2010 VBA 将多列列表框传输到命名范围

Question

我有一个 sub，我想用它来将项目从多列列表框中复制到电子表格上的命名范围。我遇到问题的子部分被注释为“转移到表”（如下）。它没有复制到我的命名范围（“Import_Items”或“Export_Items”，它们根据用作源的工作表引用某些表），而是复制到从 C 列开始的第 1 行。我觉得我在可能缺少一些非常简单的东西，任何帮助将不胜感激。

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

结束子

Answer 1

这是一次性将整个列表放入一个范围的方法：

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

这是一个显式调整表格大小的示例：

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