如何捕获A列所有非空单元格并写入另一工作表表格且不覆盖现有值

将现有VBA代码仅引用第3行，我需要捕获A列所有非空单元格，并将其值写入另一工作表的表格中，且不覆盖现有值。我尝试修改代码但未成功。代码如下：

Sub Add_My_Data() 
    Application.ScreenUpdating = False 
    Dim i As Long 
    Dim lastrow As Long 
    Dim strTitle As String 
    lastrow = Sheets("TableData").Cells(Rows.Count, "A").End(xlUp).Row + 1 
    strTitle = Sheets("NewOrder").Cells(3, 1).Value 
    With Sheets("TableData") 
        .Cells(lastrow, 1).Value = strTitle 
    End With 
    Application.ScreenUpdating = True 
End Sub

嘿，我帮你调整了代码，现在可以完美实现你要的功能——捕获NewOrder工作表A列所有非空单元格，然后追加到TableData工作表的A列（完全不会覆盖已有数据）。下面是修改后的代码：

Sub Add_My_Data()
    Application.ScreenUpdating = False ' 关闭屏幕更新，提升运行速度
    
    Dim sourceWs As Worksheet
    Dim targetWs As Worksheet
    Dim sourceRange As Range
    Dim cell As Range
    Dim targetLastRow As Long
    
    ' 定义工作表对象，让代码更清晰易维护
    Set sourceWs = ThisWorkbook.Sheets("NewOrder")
    Set targetWs = ThisWorkbook.Sheets("TableData")
    
    ' 捕获NewOrder工作表A列所有非空单元格（排除公式空值）
    On Error Resume Next ' 防止A列全空时程序报错
    Set sourceRange = sourceWs.Columns("A").SpecialCells(xlCellTypeConstants)
    On Error GoTo 0
    
    If Not sourceRange Is Nothing Then
        For Each cell In sourceRange
            ' 找到TableData工作表A列的下一个空行
            targetLastRow = targetWs.Cells(targetWs.Rows.Count, "A").End(xlUp).Row + 1
            ' 将非空单元格的值写入目标行
            targetWs.Cells(targetLastRow, "A").Value = cell.Value
        Next cell
    End If
    
    Application.ScreenUpdating = True ' 恢复屏幕更新
End Sub

关键修改点说明： #

• 捕获所有非空单元格：用SpecialCells(xlCellTypeConstants)直接定位A列所有非空的常量单元格（如果需要包含公式返回的非空值，可以改成xlCellTypeVisible或者调整逻辑）
• 绝对不覆盖数据：每次写入前重新获取目标工作表的最后一行，确保新数据永远追加在现有数据的下方
• 代码更健壮：加入了错误处理，防止A列全空时程序报错崩溃
• 可读性拉满：定义了工作表对象，代替直接硬写工作表名称，后续修改工作表名字时只需改一处即可

如果你需要只处理A列特定范围的非空单元格（比如从第2行开始），或者有其他细节需求，可以随时说，我再帮你微调～

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