错误1400：没有这样的细胞满足标准
以下是应用filter后复制数据的代码。
Sub read_excel_file(path_to_current_work_book As String, path_to_destination_workbook As String) Dim work_book As Object Dim destination_workbook As Object Dim i, m As Integer Dim array_of_account_numbers() As Variant Dim array_of_debit_or_credits() As Variant Dim current_sheets As Worksheet Dim buf_rng As Range array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") array_of_debit_or_credits = Array("10", "11", "20", "21") Application.DisplayAlerts = False Application.Visible = True Set work_book = Workbooks.Open(path_to_current_work_book) Set destination_workbook = Workbooks.Open(path_to_destination_workbook) destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" m = 2 For i = 1 To work_book.Worksheets.Count With work_book.Sheets(i) If (.UsedRange.Rows.Count > 1) Then .UsedRange.AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues .UsedRange.AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).row + 1 .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) End If End With Next i work_book.Close savechanges:=False destination_workbook.Close savechanges:=True End Sub 它会产生以下错误（当自动筛选范围（不包括标题）为空时）：“错误1400：没有这样的单元格满足标准”。
.AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m)
我该如何处理这个错误？
将其设置为一个范围，然后检查范围是否为Nothing
试试这个（UNTESTED）
Dim Rng as Range ' '~~> Rest of your code ' On Error Resume Next Set Rng = .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count _ - 1).SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Not Rng Is Nothing Then 'rng.copy... blah blah End If
如果你的数据是在列表范围（我认为必须是自动过滤），你只有一个表/列表在每张表，而不是使用随着work_book.Sheets(i)使用With work_book.Sheets(i).ListObjects(1)
下面是我的意思是一个未经testing的样本。
Sub read_excel_file(path_to_current_work_book As String, path_to_destination_workbook As String) Dim work_book As Object Dim destination_workbook As Object Dim i, m As Integer Dim array_of_account_numbers() As Variant Dim array_of_debit_or_credits() As Variant Dim current_sheets As Worksheet Dim buf_rng As Range array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") array_of_debit_or_credits = Array("10", "11", "20", "21") Application.DisplayAlerts = False Application.Visible = True Set work_book = Workbooks.Open(path_to_current_work_book) Set destination_workbook = Workbooks.Open(path_to_destination_workbook) destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" m = 2 For i = 1 To work_book.Worksheets.Count With work_book.Sheets(i).ListObjects(1) If (.Rows.Count > 1) Then .AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues .AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1 If .Range.Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then .Range.Offset(1, 0).Resize(.Range.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1).copy destination_workbook.Sheets(1).Range("A" & m) End If End If End With Next i work_book.Close savechanges:=False destination_workbook.Close savechanges:=True End Sub
实际上，我可能会推翻这整个事情尝试下面的代码，它只是检查，如果过滤的范围包含更多，然后只是1标题行，如果它的话，它会复制，如果它不跳过它，我相信是你所需要的
Sub read_excel_file(path_to_current_work_book As String, path_to_destination_workbook As String) Dim work_book As Object Dim destination_workbook As Object Dim i, m As Integer Dim array_of_account_numbers() As Variant Dim array_of_debit_or_credits() As Variant Dim current_sheets As Worksheet Dim buf_rng As Range array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") array_of_debit_or_credits = Array("10", "11", "20", "21") Application.DisplayAlerts = False Application.Visible = True Set work_book = Workbooks.Open(path_to_current_work_book) Set destination_workbook = Workbooks.Open(path_to_destination_workbook) destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" m = 2 For i = 1 To work_book.Worksheets.Count With work_book.Sheets(i) If (.UsedRange.Rows.Count > 1) Then .UsedRange.AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues .UsedRange.AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row + 1 If (.AutoFilter.Range.Rows.Count > 1) Then .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).copy destination_workbook.Sheets(1).Range("A" & m) End If End If End With Next i work_book.Close savechanges:=False destination_workbook.Close savechanges:=True End Sub
这是工作代码，产生所需的结果。 我相信，这个代码有一些改进的余地，如果有人纠正，我会很感激。 我想感谢user2140261和SiddharthRout给我有用的build议，以及分享他们的代码。
Sub extractInformationFromExcelFiles() Dim path_to_folder As String Dim path_to_final_file As String Dim path_to_current_file As String Dim objfso As Object Dim objfolder As Object Dim obj_sub_folder As Object Dim objfile As Object Dim final_workbook As Workbook path_to_folder = "" path_to_final_file = "" Set objfso = CreateObject("Scripting.FilesystemObject") Set objfolder = objfso.getfolder(path_to_folder) For Each obj_sub_folder In objfolder.subfolders For Each objfile In obj_sub_folder.Files path_to_current_file = path_to_folder & obj_sub_folder.name & "\" & objfile.name On Error Resume Next readExcelFile path_to_current_file, path_to_final_file On Error GoTo 0 Next objfile Next obj_sub_folder Set final_workbook = Workbooks.Open(path_to_final_file) End Sub Sub readExcelFile(path_to_current_work_book As String, path_to_destination_workbook As String) Dim work_book As Object Dim destination_workbook As Object Dim i, m As Integer Dim array_of_account_numbers() As Variant Dim array_of_debit_or_credits() As Variant Dim current_sheets As Worksheet Dim buf_rng As Range array_of_account_numbers = Array("1400", "1401", "1402", "1403", "1410", "1411", "1412", "1413", "1414", "1420", "1421", "1422", "1423", "1424", "1430", "1440") array_of_debit_or_credits = Array("10", "11", "20", "21") Application.DisplayAlerts = False Application.Visible = True Set work_book = Workbooks.Open(path_to_current_work_book) Set destination_workbook = Workbooks.Open(path_to_destination_workbook) destination_workbook.Sheets(1).Cells(1, 1).Value = "Debit(10,11)/Credit(20, 21)" destination_workbook.Sheets(1).Cells(1, 2).Value = "Balance account number" destination_workbook.Sheets(1).Cells(1, 3).Value = "Currency code" destination_workbook.Sheets(1).Cells(1, 4).Value = "Resident" destination_workbook.Sheets(1).Cells(1, 5).Value = "Amount" destination_workbook.Sheets(1).Cells(1, 6).Value = "Date" destination_workbook.Sheets(1).Cells(1, 7).Value = "Bank name under NBU classification" m = 2 For i = 1 To work_book.Worksheets.Count With work_book.Sheets(i) If (.UsedRange.Rows.Count > 1) Then .UsedRange.AutoFilter Field:=1, Criteria1:=array_of_debit_or_credits, Operator:=xlFilterValues .UsedRange.AutoFilter Field:=2, Criteria1:=array_of_account_numbers, Operator:=xlFilterValues m = destination_workbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).row + 1 If (.AutoFilter.Range.Rows.Count > 1) Then On Error Resume Next .AutoFilter.Range.Offset(1).Resize(.AutoFilter.Range.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy destination_workbook.Sheets(1).Range("A" & m) On Error GoTo 0 End If End If End With Next i work_book.Close savechanges:=False destination_workbook.Close savechanges:=True End Sub