同文件夹下汇总表匹配导入数据

苏阳湖wzy

各位老师，下午好！今天求助的问题是：同文件夹下，仅打开汇总表”工作簿，不打开其他工作簿，将相关数据匹配导入汇总表，详细请见附件，谢谢！

xuemei0216

Sub a()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
''当前工作簿
Dim sht As Worksheet
Set sht = ActiveSheet
'选择一个文件夹
Dim mypath$
mypath = ThisWorkbook.Path & "\"
'遍历所有文件
Dim f$, wb As Workbook, n&
f = Dir(mypath & "*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then           '避免打开重名文件
        Set wb = Workbooks.Open(mypath & f)         '打开
        n = sht.Columns(2).Find(Split(wb.Name, ".")(0), lookat:=xlWhole).Row
        sht.Cells(n, 3) = [b7]
        sht.Cells(n, 4) = [b8]
        wb.Close True           '关闭，保存更新
    End If
    f = Dir
Loop
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

苏阳湖wzy

朱荣兴 发表于 2019-9-29 16:21
位置是固定的？？

是的，朱老师！

jjmysjg

xuemei0216 发表于 2019-9-29 17:19
Sub a()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

文件夹内工作簿的名称必须与本汇总表B列名称一致