把同一个文件夹下的不同工作簿汇总到一个工作簿里

熊文来

麻烦走过路过的朋友帮忙看看我这问题。



把文件下的每个分表里的内容全部汇总到汇总表里。

chxw68

1. 代码有错。

复制代码

chxw68

代码有错。

wengjl

晚上给你一个回复，同行

wengjl

看到2楼的简单，我就不回你了

excel玉米

chxw68 发表于 2022-7-7 15:26
感觉这么简单的问题楼主自己应该会。

纵观熊老师的所有发贴，基本上确认应该是一名教师，可能平时教学时间长，没有时间在论坛上学习，都是些发贴求助，求助解决平时工作有关的内容。有时间的话，应该帮忙解决工作上的难题，可以让熊老师多出点时间来花在孩子身上。

ykcbf1100

你试一下吧。

zanghow6

Sub open_file()

Dim fso, folder1, files As Object

Dim wb As Workbook


Set fso = CreateObject("scripting.filesystemobject")

folderpath = ThisWorkbook.Path

MsgBox folderpath

Set folder1 = fso.getfolder(folderpath)

Set files = folder1.files

For Each file In files

    If Split(file.Name, ".")(0) <> Split(ThisWorkbook.Name, ".")(0) And Split(file.Name, ".")(1) <> "xlsm" Then
   
        Set wb = Workbooks.Open(folderpath & "/" & file.Name)
        
        irow = ThisWorkbook.Sheets(1).Range("a65536").End(3).Row + 1
        
        With ThisWorkbook.Sheets(1)
            
           .Cells(irow, 1).Value = Split(wb.Sheets(1).Cells(2, 7), "：")(1)
           .Cells(irow, 2).Value = wb.Sheets(1).Cells(4, 1)
           .Cells(irow, 3).Value = wb.Sheets(1).Cells(4, 4)
           .Cells(irow, 4).Value = wb.Sheets(1).Cells(4, 5)
           .Cells(irow, 5).Value = wb.Sheets(1).Cells(4, 6)
           .Cells(irow, 6).Value = wb.Sheets(1).Cells(4, 7)
           .Cells(irow, 7).Value = wb.Sheets(1).Cells(4, 8)
           .Cells(irow, 8).Value = wb.Sheets(1).Cells(6, 1)
           .Cells(irow, 9).Value = wb.Sheets(1).Cells(6, 4)
           .Cells(irow, 10).Value = wb.Sheets(1).Cells(6, 6)
           .Cells(irow, 11).Value = wb.Sheets(1).Cells(6, 7)
           .Cells(irow, 12).Value = wb.Sheets(1).Cells(6, 8)
           .Cells(irow, 13).Value = wb.Sheets(1).Cells(8, 2)
           .Cells(irow, 14).Value = wb.Sheets(1).Cells(8, 4)
           .Cells(irow, 15).Value = wb.Sheets(1).Cells(8, 5)
           .Cells(irow, 16).Value = wb.Sheets(1).Cells(8, 7)
           .Cells(irow, 17).Value = wb.Sheets(1).Cells(8, 8)
           .Cells(irow, 18).Value = wb.Sheets(1).Cells(9, 2)
           .Cells(irow, 19).Value = wb.Sheets(1).Cells(9, 4)
           .Cells(irow, 20).Value = wb.Sheets(1).Cells(9, 5)
           .Cells(irow, 21).Value = wb.Sheets(1).Cells(9, 7)
           .Cells(irow, 22).Value = wb.Sheets(1).Cells(9, 8)
           .Cells(irow, 23).Value = wb.Sheets(1).Cells(10, 2)
           .Cells(irow, 24).Value = wb.Sheets(1).Cells(10, 4)
           .Cells(irow, 25).Value = wb.Sheets(1).Cells(10, 5)
           .Cells(irow, 26).Value = wb.Sheets(1).Cells(10, 7)
           .Cells(irow, 27).Value = wb.Sheets(1).Cells(10, 8)
        
            wb.Close
            
        End With

    End If

Next

End Sub

zanghow6

Sub open_file()

Dim fso, folder1, files As Object

Dim wb As Workbook


Set fso = CreateObject("scripting.filesystemobject")

folderpath = ThisWorkbook.Path

MsgBox folderpath

Set folder1 = fso.getfolder(folderpath)

Set files = folder1.files

For Each file In files

    If Split(file.Name, ".")(0) <> Split(ThisWorkbook.Name, ".")(0) And Split(file.Name, ".")(1) <> "xlsm" Then
   
        Set wb = Workbooks.Open(folderpath & "/" & file.Name)
        
        irow = ThisWorkbook.Sheets(1).Range("a65536").End(3).Row + 1
        
        With ThisWorkbook.Sheets(1)
            
           .Cells(irow, 1).Value = Split(wb.Sheets(1).Cells(2, 7), "：")(1)
           .Cells(irow, 2).Value = wb.Sheets(1).Cells(4, 1)
           .Cells(irow, 3).Value = wb.Sheets(1).Cells(4, 4)
           .Cells(irow, 4).Value = wb.Sheets(1).Cells(4, 5)
           .Cells(irow, 5).Value = wb.Sheets(1).Cells(4, 6)
           .Cells(irow, 6).Value = wb.Sheets(1).Cells(4, 7)
           .Cells(irow, 7).Value = wb.Sheets(1).Cells(4, 8)
           .Cells(irow, 8).Value = wb.Sheets(1).Cells(6, 1)
           .Cells(irow, 9).Value = wb.Sheets(1).Cells(6, 4)
           .Cells(irow, 10).Value = wb.Sheets(1).Cells(6, 6)
           .Cells(irow, 11).Value = wb.Sheets(1).Cells(6, 7)
           .Cells(irow, 12).Value = wb.Sheets(1).Cells(6, 8)
           .Cells(irow, 13).Value = wb.Sheets(1).Cells(8, 2)
           .Cells(irow, 14).Value = wb.Sheets(1).Cells(8, 4)
           .Cells(irow, 15).Value = wb.Sheets(1).Cells(8, 5)
           .Cells(irow, 16).Value = wb.Sheets(1).Cells(8, 7)
           .Cells(irow, 17).Value = wb.Sheets(1).Cells(8, 8)
           .Cells(irow, 18).Value = wb.Sheets(1).Cells(9, 2)
           .Cells(irow, 19).Value = wb.Sheets(1).Cells(9, 4)
           .Cells(irow, 20).Value = wb.Sheets(1).Cells(9, 5)
           .Cells(irow, 21).Value = wb.Sheets(1).Cells(9, 7)
           .Cells(irow, 22).Value = wb.Sheets(1).Cells(9, 8)
           .Cells(irow, 23).Value = wb.Sheets(1).Cells(10, 2)
           .Cells(irow, 24).Value = wb.Sheets(1).Cells(10, 4)
           .Cells(irow, 25).Value = wb.Sheets(1).Cells(10, 5)
           .Cells(irow, 26).Value = wb.Sheets(1).Cells(10, 7)
           .Cells(irow, 27).Value = wb.Sheets(1).Cells(10, 8)
        
            wb.Close
            
        End With

    End If

Next

End Sub

熊文来

ykcbf1100 发表于 2022-7-7 15:57
你试一下吧。

谢谢您的帮助！