遍历不同工作簿中不同工作表，查找某一字符，并复制其所在内容到另一工作簿

liujw_35

各位朋友好：
     问题：不同的工作簿中有不同的工作表，工作表中有”合计”字符，同时这个字符是合并单元格，（工作表的格式，合并单元格很多）。
    需求：本人仅且只需要取到工作表中有“合计”字符所在  行  为起始，向上至表头的内容(A;X列），并把此内容复制到另外工作簿中，不含“合计”字符的工作表内容不复制，因为我只要“报价表”下面至“合计”止的信息。
    上千张这样的工作簿，做了好久，没出来，故请各位老师帮忙，谢谢各位！

opel-wong

题目倒不难，需要点时间，
提示一下，遍历文件夹，打开工作薄，循环工作表，条件取值，，
有空帮你写一个，

liujw_35

opel-wong 发表于 2020-1-13 10:05
题目倒不难，需要点时间，
提示一下，遍历文件夹，打开工作薄，循环工作表，条件取值，，
有空帮你写一个 ...

谢谢OPEL!

约定的童话

你这样汇总过来的目的是啥？汇总过来再整理求和？为啥不用代码一步到位呢？

liujw_35

约定的童话 发表于 2020-1-13 15:03
你这样汇总过来的目的是啥？汇总过来再整理求和？为啥不用代码一步到位呢？

我不要去求和汇总，我是想取各产品中各工序对应的工时、设备、加工费用等明细数据，如能单独获得表头如产品名称，规格，重量等数据是最好的了，与明细匹配是最佳的。如下列所示是最佳的

约定的童话

liujw_35 发表于 2020-1-13 15:25
我不要去求和汇总，我是想取各产品中各工序对应的工时、设备、加工费用等明细数据，如能单独获得表头如产 ...

可以的，明天帮你看下

liujw_35

自己顶一下，跨工作簿工作表内容复制已有代码，但条件取值不会用，本人基础不够，有老师可否修改下代码。
Option Explicit

Dim fso As Object
'主程序
Sub 测试()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set fso = CreateObject("scripting.filesystemobject")
    Range("a1:x65536").ClearContents
    recursion ThisWorkbook.Path & "\"     '递归,当前工作簿路径
End Sub
'
'查找
Sub recursion(myPath As String)
    Dim myFolder As Object, mySubFolder As Object, myFile As Object
    Set myFolder = fso.getfolder(myPath)  '获取当前路径下的文件夹
    For Each myFile In myFolder.Files
        If myFile.Name <> ThisWorkbook.Name Then
            Call closeWorkbook(myPath & "\", myFile.Name)
            Call total(myPath & "\", myFile.Name)
        End If
    Next
    For Each mySubFolder In myFolder.SubFolders  '遍历子文件夹
        recursion mySubFolder.Path    '递归,当前子文件下工作簿路径
    Next
End Sub

'关闭要打开的工作簿
Sub closeWorkbook(myPath, myFile)
    On Error Resume Next
    Workbooks(myFile).Close 0
    On Error GoTo 0
End Sub

'逐一导入
Sub total(myPath, myFile)
    Dim wk As Workbook, sh As Worksheet, i, j As Long, r As Byte, sht As Worksheet, arr
    r = 1
    Set wk = Workbooks.Open(myPath & myFile)  '打开第二层子文件
    For Each sh In wk.Sheets    '遍历其下工作表
      
    If sh.Name <> "汇总" Then
        i = sh.UsedRange.Rows.Count
        j = ThisWorkbook.Sheets("汇总").UsedRange.Rows.Count
        sh.Range("a1:x" & i).Copy
        ThisWorkbook.Sheets("汇总").Range("a" & j + 1).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
    End If
    Next
    wk.Close
   
End Sub