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.
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.