从不同的工作簿取数分别列示 （2）

zk40

在同一文件夹中不同工作簿取数，数据有点不规则，请大神出手一下

具体要求在报表样式中

shiruiqiang

练练手，对自己也是一种学习.附件去新的主题了https://club.excelhome.net/thread-1651802-1-1.html

LIUZHU

这就是那个老帖吗？

mmwwdd

表里弄一些模拟数据呀

zk40

谢谢老师们，满足需求了

chzsh

Sub Macro1()
ThisWorkbook.Sheets(1).Range("b1:aa10000").Clear
Application.ScreenUpdating = False '关闭屏幕刷新
m = 1
    Set wWB = ThisWorkbook '设置本工作簿的变量
    sPath = wWB.Path & "\" '获取本工作簿所在文件夹
    sFile = Dir(sPath & "*.xls*") '查找sPath文件夹内的与xls有关后缀名的文件
    Do While sFile <> "" '如果查找不到相关文件将会返回空字符串，找到的话，将返回文件名的全名
        If sFile <> ThisWorkbook.Name Then '如果找到的文件名不等于本工作簿的文件名
            Set wb = Workbooks.Open(sPath & sFile) '打开工作簿sFile
             m = m + 1
      ThisWorkbook.Sheets(1).Cells(1, m) = Split(wb.Name, ".")(0)
        wb.Sheets(1).Range("c5:c78").Copy ThisWorkbook.Sheets(1).Cells(2, m)
        wb.Sheets(1).Range("g5:g78").Copy ThisWorkbook.Sheets(1).Cells(76, m)
        wb.Sheets(2).Range("c5:c40").Copy ThisWorkbook.Sheets(1).Cells(150, m)
        wb.Sheets(2).Range("g5:g39").Copy ThisWorkbook.Sheets(1).Cells(186, m)
        wb.Sheets(3).Range("c5:c33").Copy ThisWorkbook.Sheets(1).Cells(221, m)
        wb.Sheets(3).Range("g5:g33").Copy ThisWorkbook.Sheets(1).Cells(250, m)
        wb.Sheets(4).Range("m9:m41").Copy ThisWorkbook.Sheets(1).Cells(279, m)

       wb.Close False   
        End If
        sFile = Dir '查询一个符合条件的文件
    Loop
   Application.ScreenUpdating = True '开启屏幕刷新
End Sub

chzsh

Sub Macro1()
ThisWorkbook.Sheets(1).Range("b1:aa10000").Clear
Application.ScreenUpdating = False '关闭屏幕刷新
m = 1
    Set wWB = ThisWorkbook '设置本工作簿的变量
    sPath = wWB.Path & "\" '获取本工作簿所在文件夹
    sFile = Dir(sPath & "*.xls*") '查找sPath文件夹内的与xls有关后缀名的文件
    Do While sFile <> "" '如果查找不到相关文件将会返回空字符串，找到的话，将返回文件名的全名
        If sFile <> ThisWorkbook.Name Then '如果找到的文件名不等于本工作簿的文件名
            Set wb = Workbooks.Open(sPath & sFile) '打开工作簿sFile
             m = m + 1
      ThisWorkbook.Sheets(1).Cells(1, m) = Split(wb.Name, ".")(0)
        wb.Sheets(1).Range("c5:c78").Copy ThisWorkbook.Sheets(1).Cells(2, m)
        wb.Sheets(1).Range("g5:g78").Copy ThisWorkbook.Sheets(1).Cells(76, m)
        wb.Sheets(2).Range("c5:c40").Copy ThisWorkbook.Sheets(1).Cells(150, m)
        wb.Sheets(2).Range("g5:g39").Copy ThisWorkbook.Sheets(1).Cells(186, m)  
        wb.Sheets(3).Range("c5:c33").Copy ThisWorkbook.Sheets(1).Cells(221, m)
        wb.Sheets(3).Range("g5:g33").Copy ThisWorkbook.Sheets(1).Cells(250, m)  
        wb.Sheets(4).Range("m9:m41").Copy ThisWorkbook.Sheets(1).Cells(279, m)           
        wb.Close False      
        End If
        sFile = Dir '查询一个符合条件的文件
    Loop
Application.ScreenUpdating = True '开启屏幕刷新
End Sub

chzsh

汇总样式，试试吧