Excel VBA颜色分类代码慢调试正常 全速运行跳过粘贴行求助

你的代码运行异常核心原因是无明确工作表对象的隐式引用：

• 代码中大量使用Select、Activate方法，以及没有指定所属工作表的Rows、Range调用，全速运行时VBA无法确定当前操作的是颜色工作表还是Master表，出现逻辑跳转异常；逐行调试时步骤间隙会自动激活对应操作的工作表，所以运行正常
• 现有逻辑冗余：先把行复制到目标表的ColorRow行再剪切到末尾的操作完全没有必要，直接计算目标表的最后可用行粘贴即可
• 代码存在无效语句：初始定义了MastSheet变量却赋值给了未声明的Master变量，还有单独一行Master无操作语句，清空旧数据时仅清空了Gray表，其余颜色表旧数据未清理

Sub Sort_Sheets()
    Dim ColorRow As Long, ColorCol As String
    Dim Master As Worksheet, TargetSheet As Worksheet
    Dim ColorVal As String, TargetLastRow As Long
    
    ' 关闭屏幕更新避免卡顿，同时禁止多余提示
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    ' 初始化对象与变量
    Set Master = Worksheets("Master Sheet")
    ColorRow = 2
    ColorCol = "D"
    
    ' 清空所有目标颜色表的旧数据
    For Each TargetSheet In Sheets(Array("Gray", "Pink", "Purple", "Yellow", "Orange", "Blue", "Rare", "Black", "Red", "Green", "White"))
        TargetSheet.Range("A2:I" & TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row).ClearContents
    Next
    
    ' 遍历Master表数据行
    Do While Master.Cells(ColorRow, ColorCol).Value <> ""
        ColorVal = UCase(Master.Cells(ColorRow, ColorCol).Value)
        
        ' 匹配对应颜色表
        Select Case True
            Case InStr(ColorVal, "WHITE") > 0: Set TargetSheet = Worksheets("White")
            Case InStr(ColorVal, "RED") > 0: Set TargetSheet = Worksheets("Red")
            Case InStr(ColorVal, "GREEN") > 0: Set TargetSheet = Worksheets("Green")
            Case InStr(ColorVal, "BLACK") > 0: Set TargetSheet = Worksheets("Black")
            Case InStr(ColorVal, "GRAY") > 0: Set TargetSheet = Worksheets("Gray")
            Case InStr(ColorVal, "BLUE") > 0: Set TargetSheet = Worksheets("Blue")
            Case InStr(ColorVal, "ORANGE") > 0: Set TargetSheet = Worksheets("Orange")
            Case InStr(ColorVal, "YELLOW") > 0: Set TargetSheet = Worksheets("Yellow")
            Case Else: ColorRow = ColorRow + 1: GoTo ContinueLoop ' 无匹配跳过当前行
        End Select
        
        ' 计算目标表最后可用行
        TargetLastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row + 1
        ' 直接复制行到目标位置
        Master.Rows(ColorRow).Copy Destination:=TargetSheet.Rows(TargetLastRow)
        
ContinueLoop:
        ColorRow = ColorRow + 1
    Loop
    
    ' 恢复系统设置
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

• 所有操作都显式指定了所属工作表，完全移除了Select、Activate等不稳定的调用，不会再出现全速运行逻辑异常的问题
• 统一使用大写匹配，避免大小写导致的匹配遗漏
• 补充了所有颜色表的旧数据清空逻辑，修复了原代码仅清空Gray表的问题
• 新增了无匹配颜色的行跳过逻辑，避免运行时报错

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