单元格关键字搜索工作簿并复制粘贴到表格

zrftjp

1.根据E12单元格的关键字搜索本工作簿所在的文件夹及子文件夹内
包含关键字的工作簿（这个关键字工作簿在这个文件夹下只有唯一一个工作簿的）。
2.打开搜索到的工作簿，然后把工作表名（数据）的A1：C1单元格内容复制到这个带宏的工作簿并已选择性粘贴（值）的形式粘贴到A1：C1单元格

太极拍天雄

打开的窗口选择“总文件夹”即可。

zrftjp

太极拍天雄 发表于 2023-2-19 23:15
打开的窗口选择“总文件夹”即可。

谢谢大神帮忙解决问题，如果能直接定位到总文件夹就更好了（C:\Users\zyh\Desktop\测试自动搜索关键字打开）大的地址在这里，谢谢大神帮忙了

太极拍天雄

调整了一下！！！

zrftjp

C:\Users\zyh\Desktop\新建文件夹 (3)Option Explicit
Dim wk As Workbook
Sub 测试1()
Dim mypath As String
mypath = "C:\Users\zyh\Desktop\20230220" & "\"
Application.ScreenUpdating = False
      Getfd (mypath)
    Application.ScreenUpdating = True
End Sub
Sub Getfd(ByVal pth)
Dim Fso, ff, fd, f
    Set Fso = CreateObject("scripting.filesystemobject")
    Set ff = Fso.getfolder(pth)
For Each f In ff.Files
If f Like "*" & Range("b2") & "*" & ".xls" & "*" Then
    Set wk = Workbooks.Open(f)
    wk.Sheets("表1").Range("f3:j3").Copy
       Sheets("表1").Range("f3:j3").PasteSpecial Paste:=xlPasteValuesAndNumberFormats     ‘这一步需要粘贴在启动宏的那个工作簿（名称不统一）
    wk.Close: Set wk = Nothing
End If
    Next f
   For Each fd In ff.subfolders
        Getfd (fd)
    Next fd
End Sub


其他都正常的

zrftjp

我是个人宏启动的