如何修改VBA宏实现每日数据添加到dados_diarios工作表首空白行

你的核心需求是让每日数据追加到dados_diarios工作表A列的首个空白行，而非覆盖原有数据。原代码的问题在于固定将数据粘贴到A2起始位置，且大量使用Select/Activate操作易引发错误。以下是修改方案：

修改后的完整代码 #

Sub outros_diario()
    Dim wsOutros As Worksheet
    Dim wsDados As Worksheet
    Dim sourceWB As Workbook
    Dim lastRow As Long
    Dim pasteRow As Long
    
    ' 定义工作表对象，避免频繁切换选中状态
    Set wsOutros = ThisWorkbook.Sheets("outros")
    Set wsDados = ThisWorkbook.Sheets("dados_diarios")
    
    ' 清空outros工作表内容
    wsOutros.Cells.Clear
    
    ' 打开外部数据文件并复制数据
    Set sourceWB = Workbooks.Open("N:\RH\Cantina\Lista_OUTROS.xlsx")
    sourceWB.Sheets(1).Cells.Copy wsOutros.Range("A1")
    sourceWB.Close SaveChanges:=False ' 关闭外部文件，不保存修改
    
    wsOutros.Activate
    ActiveWindow.DisplayGridlines = False
    
    ' 计算要复制的有效数据行（避免复制大量空行）
    lastRow = wsOutros.Cells(wsOutros.Rows.Count, "B").End(xlUp).Row
    If lastRow < 8 Then Exit Sub ' 无有效数据时直接退出宏
    
    ' 复制指定区域的值
    wsOutros.Range("B8:O" & lastRow).Copy
    
    ' 定位dados_diarios中A列的第一个空白行
    pasteRow = wsDados.Cells(wsDados.Rows.Count, "A").End(xlUp).Row + 1
    ' 粘贴到空白行起始位置
    wsDados.Range("A" & pasteRow).PasteSpecial Paste:=xlPasteValues
    
    ' 清理不需要的列
    Application.CutCopyMode = False
    wsDados.Range("C:F" & wsDados.Cells(wsDados.Rows.Count, "A").End(xlUp).Row).Delete Shift:=xlToLeft
    wsDados.Range("E:H" & wsDados.Cells(wsDados.Rows.Count, "A").End(xlUp).Row).Delete Shift:=xlToLeft
    wsDados.Columns("F:F").Delete Shift:=xlToLeft
    
    ' 自动调整列宽
    wsDados.Columns("C:C").EntireColumn.AutoFit
    wsDados.Range("H8").Select ' 保留原代码的最终选中位置（可选）
End Sub

关键修改点说明 #

• 动态定位空白行：通过wsDados.Cells(wsDados.Rows.Count, "A").End(xlUp).Row + 1精准获取A列首个空白行，确保每日数据都追加到现有数据下方，不会覆盖历史记录。
• 移除冗余选中操作：直接通过工作表对象引用执行操作，避免因窗口切换导致的宏报错，同时提升代码运行效率。
• 优化数据范围：计算实际有数据的行号lastRow，避免复制大量空行，减少无效操作。
• 规范外部文件处理：打开外部文件后直接完成数据复制，随即关闭并取消保存，避免残留未关闭的文件进程。

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