循环遍历目录的Excel继续search而不匹配
当我通过目录循环查找特定文件夹中的文件与单元格/行之间的匹配，并将这些匹配的行复制到我的主文件时，如果主站点之间没有匹配，则会收到错误91通知文件和我正在循环的文件夹中的文件。
如果一个特定的文件没有匹配，我希望我的macros自动看下一个文件等等，显然没有给我这个错误。 任何build议如何解决这个问题？
Option Explicit Sub CopyToMasterFile() Dim MasterWB As Workbook Dim MasterSht As Worksheet Dim MasterWBShtLstRw As Long Dim FolderPath As String Dim TempFile Dim CurrentWB As Workbook Dim CurrentWBSht As Worksheet Dim CurrentShtLstRw As Long Dim CurrentShtRowRef As Long Dim CopyRange As Range Dim ProjectNumber As String Dim wbname As String Dim sheetname As String wbname = ActiveWorkbook.Name sheetname = ActiveSheet.Name FolderPath = "C:\data\" TempFile = Dir(FolderPath) Dim WkBk As Workbook Dim WkBkIsOpen As Boolean For Each WkBk In Workbooks If WkBk.Name = wbname Then WkBkIsOpen = True Next WkBk If WkBkIsOpen Then Set MasterWB = Workbooks(wbname) Set MasterSht = MasterWB.Sheets(sheetname) Else Set MasterWB = Workbooks.Open(FolderPath & wbname) Set MasterSht = MasterWB.Sheets(sheetname) End If ProjectNumber = MasterSht.Cells(1, 1).Value Do While Len(TempFile) > 0 If Not TempFile = wbname And InStr(1, TempFile, "xlsx", vbTextCompare) Then Set CopyRange = Nothing With MasterSht MasterWBShtLstRw = .Cells(.Rows.Count, "A").End(xlUp).Row End With Set CurrentWB = Workbooks.Open(FolderPath & TempFile) Set CurrentWBSht = CurrentWB.Sheets(1) With CurrentWBSht CurrentShtLstRw = .Cells(.Rows.Count, "AD").End(xlUp).Row End With For CurrentShtRowRef = 1 To CurrentShtLstRw If CurrentWBSht.Cells(CurrentShtRowRef, "AD").Value = ProjectNumber Then If CopyRange Is Nothing Then set CopyRange = CurrentWBSht.Range("AE" & CurrentShtRowRef & _ ":AQ" & CurrentShtRowRef) Else Set CopyRange = Union(CopyRange, _ CurrentWBSht.Range("AE" & CurrentShtRowRef & _ ":AQ" & CurrentShtRowRef)) End If End If Next CurrentShtRowRef CopyRange.Select CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1).PasteSpecial xlPasteValues Application.DisplayAlerts = False CurrentWB.Close savechanges:=False Application.DisplayAlerts = True End If TempFile = Dir Loop ActiveSheet.Range("A1:M200").RemoveDuplicates Columns:=Array(1, 2, 4, 8, 9, 10, 11, 12), Header:=xlYes End Sub 在匹配条件之后使用这个条件（它将在匹配条件之后执行，但是保持在循环中）
if index = lastindex then 'if you have reached the end of the current file 'proceed to next file
其中index是当前文件中正在扫描的行/列的索引，lastindex是当前文件的最后lastindex （因此是当前文件的结尾）。
但是，这将要求您知道您扫描的文件的最后索引。 但是你可以通过do while循环轻松完成这个任务：
index= 1 Do While (Not IsEmpty(Sheets("YourSheetName").Cells(index, 1))) index= index+ 1 Loop index= index- 1 'remove last cell corresponding to first empty cell
这个上面的循环适用于行，但是您可以轻松地将它用于列。 希望这有助于！
更改我的macros的以下部分解决了这个问题：
Next CurrentShtRowRef If Not CopyRange Is Nothing Then CopyRange.Select CopyRange.Copy MasterSht.Cells(MasterWBShtLstRw + 1, 1).PasteSpecial xlPasteValues End If