vba脚本提取表格数据

Sub name()
    Dim FolderPath As String
    Dim FileName As String
    Dim WorkbookPath As String
    Dim SourceSheet As Worksheet
    Dim TargetSheet As Worksheet
    Dim NextRow As Long
    Dim wsName As String
    Dim dataRange As Range
    Dim data As Variant
    Dim i As Integer
    Dim found As Boolean

    ' 设置文件夹路径
    FolderPath = "D:\Work\"
    
    ' 获取文件夹中的第一个文件名
    FileName = Dir(FolderPath & "*.xls*")
    
    ' 在当前工作簿中添加一个新的工作表
    Set TargetSheet = ThisWorkbook.Sheets.Add
    TargetSheet.Name = "name"
    NextRow = 1
    
    ' 遍历文件夹中的所有Excel文件
    Do While FileName <> ""
        WorkbookPath = FolderPath & FileName
        found = False
        
        ' 打开当前Excel文件
        With Workbooks.Open(WorkbookPath)
            ' 检查是否存在目标工作表
            For Each SourceSheet In .Worksheets
                If SourceSheet.Name = "技术改造工程总表(表一)" Or SourceSheet.Name = "检修工程总表(表一)" Then
                    found = True
                    ' 提取C列第4到17行的数据
                    Set dataRange = SourceSheet.Range("C4:C17")
                    data = dataRange.Value
                    
                    ' 将文件名写入A列
                    TargetSheet.Cells(NextRow, 1).Value = FileName
                    
                    ' 将数据横向排列写入B列及之后的列
                    For i = 1 To UBound(data, 1)
                        TargetSheet.Cells(NextRow, 1 + i).Value = data(i, 1)
                    Next i
                    
                    ' 移动到下一行
                    NextRow = NextRow + 1
                End If
            Next SourceSheet
            
            ' 关闭当前工作簿，不保存更改
            .Close False
        End With
        
        ' 如果没有找到目标工作表，继续下一个文件
        If Not found Then
            Debug.Print "未在文件 " & FileName & " 中找到目标工作表"
        End If
        
        ' 获取下一个文件名
        FileName = Dir
    Loop
End Sub