使用openpyxl批量读取Excel并追加数据至新表的问题

我来帮你搞定这个Excel数据追加的坑！你遇到的两个问题——初始代码覆盖数据、清空单元格后追加错位，其实都是因为没有准确定位目标工作表的实际数据行导致的，下面一步步给你拆解解决方案：

一、先搞懂问题根源 #

1. 初始覆盖问题：你最初的代码应该是每次都从固定行（比如第2行）开始写入，没有动态找到目标表的最后一行，导致新数据直接覆盖旧数据。
2. 清空后追加错位问题：手动清空单元格后，Excel可能还保留了这些行的格式、批注或者UsedRange标记，如果你用的是简单的UsedRange.Row或者没判断第一行是否为空，代码会误以为那些空行是“已使用”的，从而跳过它们继续往后追加。

二、核心解决方案：准确定位最后一行 #

要实现正确的追加，关键是找到真正有数据的最后一行，这里给你两种可靠的方法：

方法1：基于关键列定位（推荐） #

选一个你的数据里每行都会填充的列（比如A列），用下面的代码定位：

Dim lastRow As Long
lastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "A").End(xlUp).Row
' 特殊情况：如果目标表完全为空，lastRow会是1，此时要重置为0，让数据从第1行开始写
If lastRow = 1 And TargetSheet.Cells(1, "A").Value = "" Then
    lastRow = 0
End If

这样不管你有没有清空过目标表，代码都能准确找到该从哪一行开始追加。

方法2：重置UsedRange（针对格式残留的情况） #

如果你的目标表曾经有大量数据，清空后还残留了格式，导致UsedRange范围异常大，可以在初始化目标表时重置它：

' 清空内容和格式，彻底重置UsedRange
TargetSheet.UsedRange.Clear
' 如果只想清空内容保留格式，用：TargetSheet.UsedRange.ClearContents

三、完整的可运行代码示例 #

下面是一个完整的VBA代码，能读取指定文件夹下的所有Excel工作簿，提取数据并正确追加到目标表，同时处理清空后的情况：

Sub AppendExcelData()
    Dim sourceFolder As String
    Dim sourceFile As String
    Dim sourceWB As Workbook
    Dim targetWB As Workbook
    Dim targetSheet As Worksheet
    Dim lastRow As Long
    
    ' 设定目标工作簿（这里用当前打开的工作簿，你也可以指定路径）
    Set targetWB = ThisWorkbook
    Set targetSheet = targetWB.Sheets("目标工作表") ' 替换成你的目标表名称
    
    ' 设定源文件所在的文件夹路径
    sourceFolder = "C:\你的文件存放路径\" ' 替换成你的实际文件夹路径
    sourceFile = Dir(sourceFolder & "*.xlsx") ' 只处理xlsx格式的文件
    
    ' 循环处理每个源工作簿
    Do While sourceFile <> ""
        ' 以只读模式打开源工作簿，避免锁定文件
        Set sourceWB = Workbooks.Open(Filename:=sourceFolder & sourceFile, ReadOnly:=True)
        
        ' --- 这里替换成你要读取的单元格逻辑 ---
        ' 示例：读取源工作簿第一个工作表的A1和B1单元格值
        Dim dataToAppend As Variant
        dataToAppend = Array(sourceWB.Sheets(1).Range("A1").Value, sourceWB.Sheets(1).Range("B1").Value)
        ' --- 读取逻辑结束 ---
        
        ' 定位目标表的最后一行
        lastRow = targetSheet.Cells(targetSheet.Rows.Count, "A").End(xlUp).Row
        ' 判断目标表是否为空，为空则从第1行开始写
        If lastRow = 1 And targetSheet.Cells(1, "A").Value = "" Then
            lastRow = 0
        End If
        
        ' 将数据写入目标表的下一行
        targetSheet.Cells(lastRow + 1, "A").Resize(1, UBound(dataToAppend) + 1).Value = dataToAppend
        
        ' 关闭源工作簿，不保存任何修改
        sourceWB.Close SaveChanges:=False
        
        ' 取下一个源文件
        sourceFile = Dir()
    Loop
    
    MsgBox "数据追加完成！"
End Sub

四、额外注意事项 #

• 一定要基于每行都有数据的关键列来定位最后一行，别选可能有空值的列，否则会定位错误。
• 打开源工作簿时用ReadOnly:=True，既不会锁定文件，也能提高代码运行速度。
• 如果需要每次运行代码前清空目标表，可以在循环前加入targetSheet.Cells.ClearContents（保留表头的话改成targetSheet.Rows("2:" & targetSheet.Rows.Count).ClearContents）。

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