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

Question

How can I open multiple Excel Workbooks one at a time using VBA? I created 3200 Similar Workbooks and now I need to change some formatting. I would like to create a Loop function to open the first workbook based on a master list starting on Line 5. The general Path is the same for all but each workbook is in it's own folder. The folder was created based on a column and the Workbook Document was created using another Column.

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

Then I need to open the next workbook 1 line down and so on until empty cells. A5 becomes A6 While K5 becomes K6 and so on and so forth.

I am aware I cheated and used Excel's Record Macro Tool.

Any and all Help is greatly appreciated.

Answer 1

Thanks Everyone for all your Help. I seem to have figured it out. Here's what I got if anyone else is wondering.

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