使用数组VBA从多工作表提取数据至单表时输出被覆盖问题求助

原代码的核心问题是每次处理一个工作表时，都会直接从OUTPUT的B7单元格开始写入数据，覆盖之前的结果，同时代码还存在行号逻辑错误、数组使用不当的问题，以下是修正后的完整代码：

Sub Extractdata()
    Dim ws As Worksheet, wsDest As Worksheet
    Dim i As Long, j As Long
    Dim lastRow As Long, destRow As Long
    Dim arrData As Variant
    Dim todayData As Date ' 需要确保todayData已正确赋值，比如todayData = Date
    
    ' 初始化目标工作表
    Set wsDest = ThisWorkbook.Sheets("OUTPUT")
    destRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Row + 1 ' 从已有数据的下一行开始写入
    
    ' 遍历指定工作表
    For Each ws In ThisWorkbook.Worksheets
        Select Case ws.Name
            Case "DATA1", "DATA02", "DATA03"
                ' 获取当前工作表的有效行号
                lastRow = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
                ' 遍历当前工作表的行（从第8行开始）
                For i = 8 To lastRow
                    ' 检查条件：B列非空、F列≠"1"、N列≤todayData
                    If Not IsEmpty(ws.Cells(i, "B").Value) And _
                       ws.Cells(i, "F").Value <> "1" And _
                       ws.Cells(i, "N").Value <= todayData Then
                        ' 将符合条件的行（B到Q列，即2到17列）写入目标工作表
                        wsDest.Cells(destRow, "B").Resize(1, 16).Value = ws.Range(ws.Cells(i, "B"), ws.Cells(i, "Q")).Value
                        destRow = destRow + 1 ' 目标行号递增
                    End If
                Next i
        End Select
    Next ws
End Sub

关键修改点说明： #

• 目标行号初始化：改为从OUTPUT工作表已有数据的下一行开始，避免覆盖原有内容
• 工作表行号获取：在每个目标工作表内部获取lastRow，确保行号对应当前处理的工作表
• 数据写入逻辑：找到符合条件的行后，直接将该行的B到Q列数据写入目标工作表的当前行，而非覆盖整个区域
• 代码简化：用Select Case替代多个Or判断，更简洁易维护
• 变量明确：明确todayData的类型，需确保它已被正确赋值（比如todayData = Date获取当前日期）

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