使用VBA从多个Excel文件复制相同范围的单元格

Sub CopyRangeFromMultipleFiles()
    Dim SourceFolder As String
    Dim FileExtension As String
    Dim TargetWorkbook As Workbook
    Dim SourceWorkbook As Workbook
    Dim SourceWorksheet As Worksheet
    Dim TargetWorksheet As Worksheet
    Dim SourceRange As Range
    Dim TargetRange As Range
    Dim FileName As String
    
    ' 设置源文件夹路径和文件扩展名
    SourceFolder = "C:\Path\To\Source\Folder\"
    FileExtension = "*.xlsx"
    
    ' 设置目标工作簿和工作表
    Set TargetWorkbook = ThisWorkbook
    Set TargetWorksheet = TargetWorkbook.Worksheets("Sheet1")
    
    ' 获取源文件夹中的所有文件
    FileName = Dir(SourceFolder & FileExtension)
    
    ' 循环处理每个文件
    Do While FileName <> ""
        ' 打开源文件
        Set SourceWorkbook = Workbooks.Open(SourceFolder & FileName)
        
        ' 设置源工作表和复制范围
        Set SourceWorksheet = SourceWorkbook.Worksheets("Sheet1")
        Set SourceRange = SourceWorksheet.Range("A1:B10") ' 设置要复制的范围
        
        ' 设置目标复制范围
        Set TargetRange = TargetWorksheet.Range("A1")
        
        ' 复制数据
        SourceRange.Copy TargetRange
        
        ' 关闭源文件
        SourceWorkbook.Close SaveChanges:=False
        
        ' 获取下一个文件
        FileName = Dir
    Loop
    
    ' 清理对象
    Set TargetRange = Nothing
    Set SourceRange = Nothing
    Set TargetWorksheet = Nothing
    Set SourceWorksheet = Nothing
    Set TargetWorkbook = Nothing
    Set SourceWorkbook = Nothing
End Sub