VBA宏导入CSV数据至指定工作表时覆盖问题求助

你的宏出现覆盖主表内容的问题，核心是目标工作表最后一行的定位逻辑存在漏洞，再加上依赖Activate/Select的不稳定操作共同导致的。当目标工作表从第3行开始没有数据时，Cells.Find会返回Nothing，此时lrTarget未被正确赋值，粘贴操作会默认从第1行开始，直接覆盖原有内容。

修改后的代码 #

Sub UpdateServicesData()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    Dim wsTarget As Worksheet
    Dim lrTarget As Long
    Dim lrSource As Long
    
    ' 直接指定目标工作表，避免Activate/Select带来的焦点问题
    Set wsTarget = ThisWorkbook.Worksheets("Services Data")
    
    FileToOpen = Application.GetOpenFilename("CSV or Text Files: ,*.csv;*.txt", , "Browse for your File to Import")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        
        ' 保留你原有的数据日期验证逻辑
        If OpenBook.Worksheets(1).Range("A2").Value >= ThisWorkbook.Worksheets("Home").Range("C3").Value Then
            ' 获取CSV中实际有数据的最后一行，避免复制大量空白行
            lrSource = OpenBook.Worksheets(1).Cells(OpenBook.Worksheets(1).Rows.Count, "A").End(xlUp).Row
            ' 只复制CSV中有数据的范围
            OpenBook.Worksheets(1).Range("A2:L" & lrSource).Copy
            
            ' 定位目标工作表的最后一行：从A列底部往上找，无数据则默认从第3行开始粘贴
            lrTarget = wsTarget.Cells(wsTarget.Rows.Count, "A").End(xlUp).Row
            If lrTarget < 3 Then lrTarget = 2 ' 确保下一行从第3行开始
            
            ' 直接粘贴到目标位置，无需切换选中状态
            wsTarget.Cells(lrTarget + 1, "A").PasteSpecial xlPasteAll
            
            wsTarget.Columns("A:L").AutoFit
            Application.CutCopyMode = False ' 清除复制状态，释放内存
        End If
        
        OpenBook.Close False
    End If
End Sub

关键修改点 #

• 移除Activate/Select操作：直接通过工作表对象进行操作，彻底避免因窗口焦点变化导致的粘贴位置错误。
• 修复最后一行定位逻辑：用End(xlUp)从A列底部向上查找最后一行，同时处理无数据的边界情况，确保粘贴起始位置正确。
• 复制实际数据范围：不再固定复制到L10000，而是根据CSV的实际数据行范围复制，减少不必要的空白行粘贴。

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