如何使用 VBA 引用另一个工作簿中路径和名称的单元格打开多个 Excel 工作簿

Question

如何使用 VBA 一次打开多个 Excel 工作簿？ 我创建了 3200 个类似的工作簿，现在我需要更改一些格式。 我想创建一个循环函数来基于从第 5 行开始的主列表打开第一个工作簿。所有工作簿的一般路径都相同，但每个工作簿都在它自己的文件夹中。 该文件夹是基于一列创建的，而工作簿文档是使用另一列创建的。

Sub Macro2()

Application.ScreenUpdating = False

Dim sPath As String
Dim sFile As String
Dim wb As Workbook


FileName1 = Range("A5")
FileName2 = Range("K5")

sPath = "E:\PARENTFOLDER\theFILES\"
sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm"

Set wb = Workbooks.Open(sFile)

''FORMAT TXT
Range("J10").Select 'clamp design
Selection.Font.Italic = True

Range("I3").Select 'utility parent 
Selection.Font.Bold = True

''RENAME COLUMN HEADERS
Range("G19").Select
ActiveCell.FormulaR1C1 = "TXTa?"
    Selection.Font.Bold = True
Columns("G:G").ColumnWidth = 18.57

Range("H19").Select
ActiveCell.FormulaR1C1 = "TXTb"
    Selection.Font.Bold = True
Columns("H:H").ColumnWidth = 23.29

''COPY
Range("I4").Select
Application.WindowState = xlNormal
Windows("theFILE 1.1.xlsm").Activate
Range("D5").Select
Selection.Copy
Windows(FileName2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("I4").Select

End Sub

然后我需要打开下一个工作簿 1 行，依此类推，直到空单元格。 A5 变成 A6 而 K5 变成 K6 等等。

我知道我作弊并使用了 Excel 的记录宏工具。

非常感谢任何和所有帮助。

Answer 1

感谢大家的帮助。 我好像想通了。 如果其他人想知道，这就是我得到的。

Sub Macro2()

Application.ScreenUpdating = False

Dim sFile As String
Dim wb As Workbook
Dim FileName1 As String
Dim FileName2 As String
Dim wksSource As Worksheet
Const scWkbSourceName As String = "theFILE 1.1.xlsm"

Set wkbSource = Workbooks(scWkbSourceName)
Set wksSource = wkbSource.Sheets("Sheet1") ' Replace Sheet1 with the sheet name

Const wsOriginalBook As String = "theFILE 1.1.xlsm"
Const sPath As String = "E:\ParentFolder\theFILES\"

SourceRow = 5

Do While Cells(SourceRow, "D").Value <> ""

FileName1 = wksSource.Range("A" & SourceRow).Value
FileName2 = wksSource.Range("K" & SourceRow).Value

sFile = sPath & FileName1 & "\" & FileName2 & ".xlsm"

Set wb = Workbooks.Open(sFile)

''FORMAT TXT
Range("J10").Select
Selection.Font.Italic = True

Range("I3").Select 
Selection.Font.Bold = True

''RENAME COLUMN HEADERS
Range("G19").Select
ActiveCell.FormulaR1C1 = "WHO MADE THIS?"
    Selection.Font.Bold = True
Columns("G:G").ColumnWidth = 18.57

Range("H19").Select
ActiveCell.FormulaR1C1 = "MANU"
    Selection.Font.Bold = True
Columns("H:H").ColumnWidth = 23.29

''ADD COMPANY
Range("I4").Select
Application.WindowState = xlNormal
Windows("theFILE 1.1.xlsm").Activate
Range("D5").Select
Selection.Copy
Windows(FileName2).Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Range("I4").Select


'''CLOSE WORKBOOK W/O BEFORE SAVE FUNCTION
Application.EnableEvents = False
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.EnableEvents = True

SourceRow = SourceRow + 1 ' Move down 1 row for source sheet

Loop

End Sub