VBA循环搜索复制粘贴报错：需宏跳过空白或非数字单元格

原代码功能是遍历文件夹内所有工作簿，在指定工作表A列搜索用户输入的编号，复制匹配行到目标工作表，但因A列存在空白、文本内容导致运行异常，以下是修复方案：

核心修改点 #

• 调整遍历范围：原代码碰到空白行就终止遍历，改为遍历A列所有有数据的行（包括中间有空白的情况）
• 统一匹配类型：将单元格值和搜索值都转为字符串，避免数字与文本类型不匹配导致的判断错误
• 优化交互逻辑：把输入搜索编号的步骤移到遍历文件之前，无需重复输入
• 完善文件处理：打开文件后自动关闭并选择是否保存，避免弹窗干扰
• 增加错误捕获：处理找不到指定工作表的异常情况

修复后的完整代码 #

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Dim LSearchValue As String
    Dim LCopyToRow As Long
    
    ' 获取用户输入的搜索编号，只输入一次
    LSearchValue = InputBox("Please enter the staff ID.", "Enter value")
    If LSearchValue = "" Then Exit Sub ' 用户取消输入则退出
    
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        
        ' 初始化目标工作表的起始行（从第1行开始，可根据需求调整）
        LCopyToRow = 1
        
        Do While xFileName <> ""
            On Error Resume Next ' 捕获打开文件或工作表不存在的错误
            With Workbooks.Open(xFdItem & xFileName)
                Dim WshtSrc As Worksheet
                Dim WshtDest As Worksheet
                Dim LSearchRow As Long
                Dim LastRow As Long
                
                ' 尝试获取源工作表和目标工作表
                Set WshtSrc = .Worksheets("Search")
                Set WshtDest = ThisWorkbook.Worksheets("Dest") ' 目标表放在当前宏所在工作簿
                
                If Not WshtSrc Is Nothing And Not WshtDest Is Nothing Then
                    ' 获取A列最后一行的行号，不管中间有没有空白
                    LastRow = WshtSrc.Cells(WshtSrc.Rows.Count, "A").End(xlUp).Row
                    
                    ' 遍历A列所有行
                    For LSearchRow = 1 To LastRow
                        ' 统一转为字符串比较，兼容数字、文本、空白
                        If CStr(WshtSrc.Range("A" & LSearchRow).Value) = LSearchValue Then
                            ' 复制匹配行到目标工作表
                            WshtSrc.Rows(LSearchRow).Copy Destination:=WshtDest.Cells(LCopyToRow, 1)
                            LCopyToRow = LCopyToRow + 1
                        End If
                    Next LSearchRow
                Else
                    MsgBox "文件 " & xFileName & " 中未找到指定工作表", vbExclamation
                End If
                
                ' 关闭打开的工作簿，不保存修改（如需保存改为True）
                .Close SaveChanges:=False
            End With
            On Error GoTo 0 ' 关闭错误捕获
            
            xFileName = Dir
        Loop
    End If
End Sub

代码说明 #

• 搜索值输入移到开头，避免重复弹窗
• 使用LastRow获取A列最后一行，确保遍历所有数据行，包括中间有空白的情况
• 用CStr()统一转换单元格值和搜索值，解决数字与文本匹配失败的问题
• 目标工作表指定为宏所在工作簿（ThisWorkbook），避免混淆
• 增加错误捕获，处理工作表不存在的情况
• 自动关闭打开的工作簿并设置不保存，避免手动操作

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