0

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.

Martijn Pieters
  • 1,048,767
  • 296
  • 4,058
  • 3,343
Kenny
  • 343
  • 2
  • 9
  • 28
  • This answer https://stackoverflow.com/a/19157769/5103770 should help to get you started. – Stadem Jul 11 '18 at 16:42
  • @Stadem I have edited a the Question to incorporate my current VBA Code. How do I move down one row for both Range("A5") and Range("K5")? – Kenny Jul 11 '18 at 18:16
  • As you mentioned, use a loop. Go back to @GlennFromIowa's answer https://stackoverflow.com/a/50380337/5103770 to your previous question and try using the Do While Loop that he suggested. Make sure you understand what's happening in the "Do While _____" condition check so that you don't get stuck in an infinite loop. You'll use lines like `FileName1 = wsOriginalWorksheet.Range("A"&SourceRow).Value`. And if you get super-frustrated, it's probably because of the Record Macro Tool lines. They got you this far, now it's time to replace them. Good luck. – Stadem Jul 11 '18 at 20:52

1 Answers1

0

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
Kenny
  • 343
  • 2
  • 9
  • 28