VBA Do循环中If Else关闭文件时重复打开同一文件死循环问题

死循环的核心逻辑错误是：控制遍历下一行的单元格偏移代码，被写在了If判断成立的分支内部。
当遍历到的文件不满足判断条件、走入Else分支时，代码只会执行关闭文件的操作，完全不会触发选中下一行单元格的逻辑。下一轮循环启动时，ActiveCell仍然停留在当前不符合条件的单元格上，因此会反复打开、关闭同一个文件，永远无法遍历到列表下一行。

将「关闭当前酒店文件」「跳转回Hotel_List表选中下一行」这两段公共逻辑，从If/Else分支中移出，放到If...End If块之后、Loop语句之前。无论当前文件是否满足数据提取条件，处理完成后都会统一执行关闭、下移操作，保证循环能正常遍历所有路径。
顺带做了三处稳定性优化，避免其他潜在报错：

• 不再依赖ActiveWorkbook获取打开的酒店文件对象，直接将Open方法返回的工作簿对象赋值给变量，避免焦点漂移导致关错文件、取错工作表
• 原代码中Range("G2") > "0"是文本格式比较，改为和数值0比较，避免文本格式数字判断失效
• 重复使用的汇总工作簿名称、工作表保护密码提取为常量，后续修改无需逐行查找替换

Sub Control_AR_AD_Copy_Hotel_DataArchive_And_Control()
'
' In summary loops through list of hotel file paths and copies the data archive and control information until complete.
'

' 定义全局常量
Const CONSOLIDATED_WB As String = "Consolidated_Accounts_Receivable_Aged_Debtors"
Const SHEET_PWD As String = "DebRepAcc"

' Creates list of hotels we expect an aged debtor report for.
'
    Sheets("Hotel_List").Select
    Range("A4:Z103").Select
    Selection.ClearContents
    Range("A1").Select
    Sheets("Tables").Select
    ActiveSheet.Range("$D$4:$Q$103").AutoFilter Field:=4, Criteria1:="Yes"
    Range("D4:Q103").Select
    Selection.Copy
    Sheets("Hotel_List").Select
    Range("A3").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Cells.Select
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Cells.EntireColumn.AutoFit
    Range("A1").Select

' Copy Data Archive to Previous and clear data archive
    Sheets("Data_Archive_All").Select
    Range("A2:Z2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("A2").Select
    Sheets("Data_Archive_Previous").Select
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A2").Select
    Application.CutCopyMode = False
    Sheets("Data_Archive_All").Select
    Range("A2:Z2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.ClearContents
    Range("A2").Select
    Sheets("Control").Select
    Range("A1").Select
    
' Select cell where Loop begins as first line of data.
    Sheets("Hotel_List").Select
    Range("F4").Select

' Set Do loop to stop when an empty cell is reached.
    Do Until IsEmpty(ActiveCell)

' Open hotel file as read only.
    Dim hotel_wb As Workbook
    Dim file_path As String
    file_path = ActiveCell.Value
    Set hotel_wb = Workbooks.Open(Filename:=file_path, ReadOnly:=True)

' Set If Statement based upon values in Data_Archive and Control worksheet
    If hotel_wb.Sheets("Data_Archive").Range("G2") > 0 And hotel_wb.Sheets("Control").Range("T18") = "Yes" Then
            
' Remove filter from Hotel's Data Archive and unprotect worksheet.
    hotel_wb.Sheets("Data_Archive").Select
    Range("A2").Select
    ActiveSheet.Unprotect SHEET_PWD
    ActiveSheet.AutoFilter.ShowAllData
    
' Apply filter and copy data from Hotel's Data Archive.
    Range("A2").Select
    ActiveSheet.Range("B1").AutoFilter Field:=25, Criteria1:="1"
    Range("$A$2:$Z$50001").Select
    Selection.Copy
    
' Paste data into Consolidated Data Archive in next blank cell.
    Workbooks(CONSOLIDATED_WB).Activate
    Sheets("Data_Archive_All").Select
    Range("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False

' Remove filter from Hotel's Data Archive and protect worksheet.
    hotel_wb.Activate
    Sheets("Data_Archive").Select
    ActiveSheet.AutoFilter.ShowAllData
    ActiveSheet.Protect SHEET_PWD, DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFiltering:=True
            
' Copy data from Control worksheet.
    Sheets("Control").Select
    ActiveSheet.Calculate
    Range("C3:T18").Select
    Selection.Copy

' Paste Control Data into Control Convert worksheet.
    Workbooks(CONSOLIDATED_WB).Activate
    Sheets("Control_Convert").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    ActiveSheet.Calculate
    
' Copy data from Control_Convert into Control_Current in next blank cell.
    Sheets("Control_Convert").Select
    Range("A20:O20").Select
    Selection.Copy
    Sheets("Control_Current").Select
    Range("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False

    End If

' 统一执行关闭文件、下移行逻辑，无论是否满足判断条件都会执行
    hotel_wb.Close savechanges:=False
    Workbooks(CONSOLIDATED_WB).Activate
    Sheets("Hotel_List").Select
    ActiveCell.Offset(1, 0).Select

    Loop
   
'
' Copy data from Control_Current into Control_Archive in next blank cell.
'
    Workbooks(CONSOLIDATED_WB).Activate
    Sheets("Control_Current").Select
    Range("A2:O101").Select
    Selection.Copy
    Sheets("Control_Archive").Select
    Range("A:A").Select
    Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False, SearchFormat:=False).Activate
    ActiveCell.Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Range("A1").Select
    Application.CutCopyMode = False
    Sheets("Control").Select
    Range("A1").Select
    
End Sub

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