Excel VBA动态填充日期至新增数据末尾技术求助

需求说明 #

• 每周初将「Weekly Appt Data」的周报数据追加到「Appointment Data」的累计报表底部
• A列需从动态起始行填充到B列最后一行，日期规则为上一录入日期加7天（避免节假日延后执行时录错日期）
• 当前代码已完成数据复制粘贴，但A列日期无法实现动态范围填充

现有代码问题 #

1. 大量使用Select/Activate，易出错且效率低
2. 日期填充部分错误操作了「Weekly Appt Data」工作表，而非目标累计报表
3. 未准确定位填充的起始和结束位置

修正后的完整代码 #

Sub UpdateAppointmentData()
    ' 声明变量
    Dim wsWeekly As Worksheet
    Dim wsCumulative As Worksheet
    Dim lastRowWeekly As Long
    Dim startRowCumulative As Long
    Dim lastRowCumulative As Long
    Dim startDate As Date
    
    ' 绑定工作表对象（避免用Select切换表）
    Set wsWeekly = ThisWorkbook.Sheets("Weekly Appt Data")
    Set wsCumulative = ThisWorkbook.Sheets("Appointment Data")
    
    ' --- 1. 复制周报数据到累计报表底部 ---
    ' 获取周报数据最后一行（从B列判断，因为A列无数据）
    lastRowWeekly = wsWeekly.Cells(wsWeekly.Rows.Count, "B").End(xlUp).Row
    ' 定位累计报表的粘贴起始行：Dealer Name列最后一行的下一行
    startRowCumulative = wsCumulative.Range("Main[Dealer Name]").Cells(wsCumulative.Range("Main[Dealer Name]").Count).Row + 1
    
    ' 复制周报所有有效列数据，粘贴到累计报表的B列起始行
    wsWeekly.Range("A2", wsWeekly.Cells(lastRowWeekly, wsWeekly.Cells(1, wsWeekly.Columns.Count).End(xlToLeft).Column)).Copy
    wsCumulative.Cells(startRowCumulative, "B").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    
    ' --- 2. 批量填充A列日期 ---
    ' 获取累计报表B列最后一行（刚粘贴数据的末尾行）
    lastRowCumulative = wsCumulative.Cells(wsCumulative.Rows.Count, "B").End(xlUp).Row
    ' 取上一个已录入的日期
    startDate = wsCumulative.Range("Main[Date]").Cells(wsCumulative.Range("Main[Date]").Count).Value
    ' 给A列整个目标区域批量赋值（所有新增行日期都是上一日期+7天）
    wsCumulative.Range(wsCumulative.Cells(startRowCumulative, "A"), wsCumulative.Cells(lastRowCumulative, "A")).Value = startDate + 7
End Sub

关键改进点 #

• 去掉冗余操作：不再用Select切换工作表和单元格，直接通过对象引用操作，代码更稳定
• 动态定位行号：通过结构化引用Main[Dealer Name]和Main[Date]自动找最后一行，避免固定行号导致的错误
• 高效日期填充：因为新增行的日期都是同一个值（上一日期+7天），直接给整个区域批量赋值，比AutoFill更简洁高效

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