VBA筛选后复制文件至指定文件夹报错（Error 75）求助

你的代码出现**Path/File access error (Error 75)**的核心原因是路径拼接逻辑错误，生成了无效的源路径和目标路径，具体问题及修复如下：

核心错误点 #

1. 源路径重复拼接：SourcePath已经是单元格里的完整源文件路径，代码里又重复拼接了一次Selection.Cells(i, "K").Value，导致源路径变成Z:\test\123456\xxx.pdfZ:\test\123456\xxx.pdf，完全无效。
2. 目标路径格式错误：直接把完整源路径拼到目标文件夹后，会生成Z:\test2\Z:\test\123456\xxx.pdf这种嵌套绝对路径，系统无法识别。需要从源路径中提取文件名，再和目标文件夹拼接。

修复后的完整代码 #

Sub CopyFiles()
    Dim sourceFullPath As String
    Dim targetFolder As String
    Dim targetFullPath As String
    Dim fileName As String
    Dim cell As Range
    
    ' 获取目标文件夹路径，确保末尾有反斜杠
    targetFolder = Range("N1").Value
    If Right(targetFolder, 1) <> "\" Then
        targetFolder = targetFolder & "\"
    End If
    
    ' 遍历选中区域的K列单元格（仅处理筛选后的可见行）
    For Each cell In Intersect(Selection, Columns("K")).SpecialCells(xlCellTypeVisible)
        sourceFullPath = cell.Value
        ' 跳过空单元格
        If sourceFullPath = "" Then GoTo NextCell
        
        ' 从源路径提取文件名
        fileName = Mid(sourceFullPath, InStrRev(sourceFullPath, "\") + 1)
        targetFullPath = targetFolder & fileName
        
        ' 检查源文件是否存在
        If Dir(sourceFullPath) <> "" Then
            ' 捕获复制时的冲突、权限等错误
            On Error Resume Next
            FileCopy sourceFullPath, targetFullPath
            On Error GoTo 0
        Else
            MsgBox "源文件不存在：" & sourceFullPath, vbExclamation
        End If
        
NextCell:
    Next cell
    MsgBox "复制完成。"
End Sub

额外优化说明 #

• 适配筛选场景：用SpecialCells(xlCellTypeVisible)确保只处理筛选后选中的有效行，避免遍历隐藏行。
• 自动补全路径分隔符：防止目标路径末尾未加\导致拼接错误。
• 增加文件存在性检查：避免因源文件不存在触发错误。
• 加入错误捕获：处理文件重名、权限不足等复制时的意外情况。

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