批量提取多个excel内指定单元格名称

确保该文件夹下的Excel文件只有这100多，建一新Excel，也存到该文件夹。仅打开该新Excel，同时按Alt+F11进入宏界面，点菜单的插入，模块，在右边窗口粘贴如下代码：
Sub Find()
Application.ScreenUpdating = False
Dim MyDir As String
Dim i As Integer
i = 2
MyDir = ThisWorkbook.Path & "\"
ChDrive Left(MyDir, 1) 'find all the excel files
ChDir MyDir
Match = Dir$("*.xls")
Do
If Not LCase(Match) = LCase(https://www.doczj.com/doc/ff4335906.html,) Then
Workbooks.Open Match, 0, 1
ThisWorkbook.ActiveSheet.Range("A" & i) = Match
ThisWorkbook.ActiveSheet.Range("B" & i) = ActiveWorkbook.Sheets("Sheet1").Range("A3")
ThisWorkbook.ActiveSheet.Range("C" & i) = ActiveWorkbook.Sheets("Sheet1").Range("D5")
ActiveWorkbook.Close 0
i = i + 1
End If
Match = Dir$
Loop Until Len(Match) = 0
Application.ScreenUpdating = True
End Sub

在此界面下直接按F5运行此宏，等一会，完成。

如果你A3、D5等不多几个单元格，继续复制粘贴
ThisWorkbook.ActiveSheet.Range("C" & i) = ActiveWorkbook.Sheets("Sheet1").Range("D5")
把粗体字修改。
如果很多且有规律，可以用一个循环解决。
{注：.xls；根据自己文件改后缀；Sheet1：提取的当前页面；A3：提取的某一个单元格。
然后下载“更名大师”进行批量更改