从主表复制筛选行至另一表的VBA代码报错求助（Error 91）

需要从「MASTER - Supplier File」工作表的MSF_Table中提取条形码和成本价，生成「DATA - Barcode List」工作表的BCODE_Table。当前存在两个问题：

• 仅能正常复制条形码列，成本价列未被复制；
• 选择供应商时，代码在VisRange.Copy处触发Error 91错误（对象变量或With块变量未设置）。

Option Explicit

Sub CreateBarcodeExportList()

      Const PROC_TITLE As String = "Create Barcode Export List'"
'=====================================================================================
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
'=====================================================================================
    Dim FromWs As Worksheet
    Set FromWs = Sheets("MASTER - Supplier File")
    
    Dim ToWs As Worksheet
    Set ToWs = Sheets("DATA - Barcode List")
    
    Dim FromTbl As ListObject
    Set FromTbl = FromWs.ListObjects("MSF_Table")
    
    Dim ToTbl As ListObject
    Set ToTbl = ToWs.ListObjects("BCODE_Table")
   
    
    Dim ToTbl_LastRow As Long
    Dim VisRange As Range
    Dim Torange As Range
    Dim VisRange2 As Range
    Dim Torange2 As Range
    Dim Maxlimit As Variant
    
    Dim Supplier As Variant
'=====================================================================================
        ' Clear
        
        With ToTbl
        
        'Check If any data exists in the table
        If Not .DataBodyRange Is Nothing Then
            'Clear Content from the table
            .DataBodyRange.ClearContents
        End If
        
    End With
    Range("a5").Activate
ToTbl.Resize Range("a4:c5")
'=====================================================================================
     'Ensure Filteris reset
     
       With FromTbl
        If .ShowAutoFilter Then
            If .AutoFilter.FilterMode Then .AutoFilter.ShowAllData
        End If
     End With
     
     Maxlimit = ToWs.Range("b1").Value
     Supplier = ToWs.Range("b2").Value
     Maxlimit = Maxlimit + 1
     
     ' Filter table
     
     If Supplier = "" Then
   FromTbl.Range.AutoFilter Field:=5, Criteria1:=Array("Valid"), Operator:=xlFilterValues
Else
FromTbl.Range.AutoFilter Field:=5, Criteria1:=Array("Valid"), Operator:=xlFilterValues
FromTbl.Range.AutoFilter Field:=3, Criteria1:=Array(Supplier), Operator:=xlFilterValues

End If

    
    ' Copy filtered table
    On Error Resume Next
    Set VisRange = FromTbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
       
     If VisRange Is Nothing Then
     MsgBox "No Valid Barcodes Selected.", vbInformation, PROC_TITLE
     GoTo ProcessEnd
    End If
    

Set VisRange = Application.Intersect(VisRange, FromWs.Range("F2: f" & Maxlimit))
Maxlimit = Maxlimit + 5

Set Torange = ToWs.Range("a5: a" & Maxlimit)

   
    
     VisRange.Copy
     Torange.PasteSpecial xlPasteValues
   


    ToWs.Calculate
    With ToTbl.Range
        ToTbl_LastRow = .Cells(.Cells.Count).Row
    End With
    
    
    ToTbl.Resize Range("a4:c" & ToTbl_LastRow)
ProcessEnd:
   
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    End Sub

1. Error 91 错误修复 #

筛选供应商后，若没有符合条件的行，VisRange经过Intersect操作后会变为Nothing，但原代码仅在Intersect前做了一次非空判断，后续未再次验证，导致执行VisRange.Copy时触发错误。需在Intersect后新增范围有效性检查。

2. 成本价列未复制的修复 #

原代码仅处理了条形码所在的F列，需新增成本价列的提取逻辑（以下代码假设成本价在MSF_Table的G列，需根据实际结构调整），同时确保复制的成本价与条形码行对应。

Option Explicit

Sub CreateBarcodeExportList()

    Const PROC_TITLE As String = "Create Barcode Export List"
'=====================================================================================
    Application.Calculation = xlCalculationManual
    Application.DisplayStatusBar = False
    Application.EnableEvents = False
    Application.ScreenUpdating = False
'=====================================================================================
    Dim FromWs As Worksheet
    Set FromWs = Sheets("MASTER - Supplier File")
    
    Dim ToWs As Worksheet
    Set ToWs = Sheets("DATA - Barcode List")
    
    Dim FromTbl As ListObject
    Set FromTbl = FromWs.ListObjects("MSF_Table")
    
    Dim ToTbl As ListObject
    Set ToTbl = ToWs.ListObjects("BCODE_Table")
   
    Dim ToTbl_LastRow As Long
    Dim VisBarcodeRange As Range ' 条形码可见范围
    Dim VisCostRange As Range    ' 成本价可见范围
    Dim TargetBarcodeRange As Range
    Dim TargetCostRange As Range
    Dim Maxlimit As Variant
    Dim Supplier As Variant
'=====================================================================================
    ' 清空目标表格数据
    With ToTbl
        If Not .DataBodyRange Is Nothing Then
            .DataBodyRange.ClearContents
        End If
    End With
    ToTbl.Resize ToWs.Range("a4:c5") ' 重置表格初始大小
'=====================================================================================
    ' 重置筛选状态
    With FromTbl
        If .ShowAutoFilter And .AutoFilter.FilterMode Then
            .AutoFilter.ShowAllData
        End If
    End With
     
    Maxlimit = ToWs.Range("b1").Value + 1
    Supplier = ToWs.Range("b2").Value
     
    ' 应用筛选条件
    FromTbl.Range.AutoFilter Field:=5, Criteria1:="Valid" ' 简化单条件筛选写法
    If Supplier <> "" Then
        FromTbl.Range.AutoFilter Field:=3, Criteria1:=Supplier
    End If

    ' 获取可见数据范围
    On Error Resume Next
    Set VisBarcodeRange = FromTbl.DataBodyRange.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
       
    If VisBarcodeRange Is Nothing Then
        MsgBox "No Valid Barcodes Selected.", vbInformation, PROC_TITLE
        GoTo ProcessEnd
    End If
    
    ' 提取条形码列（F列）和成本价列（假设为G列，需根据实际调整）
    Set VisBarcodeRange = Application.Intersect(VisBarcodeRange, FromWs.Range("F2:F" & Maxlimit))
    Set VisCostRange = Application.Intersect(VisBarcodeRange.EntireRow, FromWs.Range("G:G")) ' 通过整行关联成本列
    
    ' 再次检查范围有效性
    If VisBarcodeRange Is Nothing Then
        MsgBox "No Barcode data within the limit range.", vbInformation, PROC_TITLE
        GoTo ProcessEnd
    End If
    
    ' 设置目标单元格范围
    Set TargetBarcodeRange = ToWs.Range("A5").Resize(VisBarcodeRange.Cells.Count)
    Set TargetCostRange = ToWs.Range("B5").Resize(VisCostRange.Cells.Count) ' 假设成本价放到B列
    
    ' 复制数据
    VisBarcodeRange.Copy
    TargetBarcodeRange.PasteSpecial xlPasteValues
    
    VisCostRange.Copy
    TargetCostRange.PasteSpecial xlPasteValues
    
    ' 调整目标表格大小
    ToWs.Calculate
    With ToTbl.Range
        ToTbl_LastRow = .Cells(.Cells.Count).Row
    End With
    ToTbl.Resize ToWs.Range("a4:c" & ToTbl_LastRow)
    
ProcessEnd:
    ' 恢复Excel环境设置
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayStatusBar = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

关键调整说明 #

• 成本价列位置（代码中G列）和目标列位置（代码中B列）需根据实际表格结构修改；
• 简化了单条件筛选写法，避免不必要的Array包裹；
• 新增两次范围有效性检查，彻底规避Error 91；
• 通过EntireRow关联条形码与成本价的可见行，确保数据一一对应。

内容的提问来源于stack exchange，提问作者craig crowhurst