目标

源文件为每月的财务报表，查找值所在的单元格位置、表页结构和表页名称相同。

局限和特点

目标文件和源文件必须在同一个文件夹内
设置条件，指定值和参数，如表页名称，目标值名称，目标值的单元格地址

程序

Private Sub CommandButton1_Click()
Dim start As Double
start = Timer '设置计时器
Dim myfile, mypath, wb '声明变量
Application.ScreenUpdating = False '关闭屏幕更新
'预设定义
Sheets("结果表").UsedRange.Clear
R1 = Sheets("条件表").Range("B5").CurrentRegion.Rows.Count - 1 'b5单元格CTRL+A的区域的行数-1
Sheets("条件表").Range("B5").Resize(R1, 1).Copy
Sheets("结果表").Range("B1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True '转置
R2 = Sheets("条件表").Range("C2")
'预设定义执行完毕
mypath = ThisWorkbook.Path
myfile = Dir(mypath & "\*.xls*") '遍历当前文件夹内所有xls*文件
N1 = 1 'N1为J结果表中行序号,和N1+1配合使用，放到哪个循环外
Do While myfile <> ""
If myfile <> ThisWorkbook.Name Then
Set wb = GetObject(mypath & "\" & myfile) 'wb为工作簿
  For I = 1 To wb.Sheets.Count
    On Error Resume Next '报错跳过
    If wb.Sheets(I).Name = R2 Then
      Sheets("结果表").Range("A1").Offset(N1, 0) = wb.Name
      For J = 1 To R1
      R3 = Sheets("条件表").Range("C5").Offset(J - 1, 0)
      Sheets("结果表").Range("A1").Offset(N1, J) = wb.Sheets(R2).Range(R3)
      Next J
    End If
  Next I
'主体程序执行完毕
wb.Close False
N1 = N1 + 1
End If
myfile = Dir
Loop
Application.ScreenUpdating = True
MsgBox "运行程序使用" & Format(Timer - start, "0.00") & "秒"
End Sub