VBA宏重复运行时覆盖当日已有数据问题求助

你的宏每次运行时会把H4:H200的**全部内容（含空白单元格）**直接覆盖到目标日期列的对应行，所以之前录入的旧数据会被空白冲掉。核心问题是没有区分输入区域里的空值和有效数据，也没有保留目标区域已有的非空数据。

修改代码，实现两个核心逻辑：

• 只复制输入表中非空的单元格
• 粘贴时仅更新目标列中对应行的空单元格（或根据需求选择是否覆盖已有数据）

以下是优化后的代码，同时去掉了低效的Select/Activate操作：

Sub copyHME()
    Dim inputSheet As Worksheet
    Set inputSheet = ActiveWorkbook.Worksheets("Data Entry - HME")
    
    Dim outputSheet As Worksheet
    Set outputSheet = ActiveWorkbook.Worksheets("SMU - HME")
    
    Dim targetDate As Variant
    targetDate = DateTime.DateValue(inputSheet.Range("H2").Value)
    
    ' 解锁目标工作表
    outputSheet.Unprotect Password:="XXX"
    
    ' 清除筛选
    If outputSheet.AutoFilterMode Then
        outputSheet.AutoFilter.ShowAllData
    End If
    
    ' 查找目标日期所在的列
    Dim targetCol As Integer
    targetCol = 0
    Dim currentCell As Range
    For Each currentCell In outputSheet.Range("3:3")
        If IsDate(currentCell.Value) Then
            If DateTime.DateValue(currentCell.Value) = targetDate Then
                targetCol = currentCell.Column
                Exit For
            End If
        End If
    Next
    
    ' 找到目标列后才执行复制逻辑
    If targetCol > 0 Then
        Dim inputRow As Long
        ' 遍历输入区域的每一行，只处理非空单元格
        For inputRow = 4 To 200
            Dim inputVal As Variant
            inputVal = inputSheet.Cells(inputRow, "H").Value
            
            ' 仅当输入单元格有值时，才更新目标列对应行
            If inputVal <> "" Then
                ' 目标行和输入行对应（输入行4对应目标行4，以此类推）
                Dim targetRow As Long
                targetRow = inputRow
                
                ' 直接赋值，避免复制粘贴的低效操作
                outputSheet.Cells(targetRow, targetCol).Value = inputVal
            End If
        Next inputRow
    End If
    
    Call MacroLock
    MsgBox "Data entry completed"
End Sub

• 只复制有效数据：遍历输入区域时，跳过空白单元格，仅当输入有值时才更新目标列
• 避免覆盖旧数据：不会用空白单元格覆盖目标列已有的非空数据
• 去掉Select/Activate：直接通过单元格对象操作，提升代码运行速度和稳定性
• 明确目标列定位：用targetCol变量存储目标列号，逻辑更清晰

如果需要保留"仅当目标单元格为空时才更新"的逻辑（即不覆盖目标列已有的任何数据），可以把赋值部分改成：

If inputVal <> "" And outputSheet.Cells(targetRow, targetCol).Value = "" Then
    outputSheet.Cells(targetRow, targetCol).Value = inputVal
End If

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