How do I loop over Excel files in a shared drive and make/save changes on each of them?

Question

I'm in a bit of a time crunch, and my beginner VBA skills are failing me.

I have 900 files in a shared drive folder and I need a macro to open each file, center and align a few cells, save and close, and move to the next file.

Could someone help me in writing this code? I have the formatting section down.

Thank you so much!

    Range("B45:B51").Select
Application.CutCopyMode = False
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Range("M45:M48").Select
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Range("C45:C51").Select
With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Range("N45:N48").Select
With Selection
    .HorizontalAlignment = xlLeft
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With

We sincerely suggest you post your working code for the formatting. You have the duty of, at the very least, providing us with some canvas to paint on, buddy. :) Off the top of my head, this is a simple application of either `Dir` or `FSO`. — WGS, Feb 13 '14 at 20:12
Use the idea of **[FileSystemObject](http://msdn.microsoft.com/en-us/library/6tkce7xa(v=vs.84).aspx)** as `Application.FileSearch` no longer exist from Office 2007. Then just make 2 Subs (with Range as input) for the formatting (appears to be only have 2 unique styles you displayed). Call these Subs for each file to be opened in loop. — PatricK, Feb 13 '14 at 23:02
[**This question**](http://stackoverflow.com/questions/10380312/loop-through-files-in-a-folder-using-vba) should help you with how to loop through the files. — ARich, Feb 14 '14 at 00:10

score 1 · Accepted Answer · answered Feb 13 '14 at 23:09

Do you have a list of the names of the files you want to open? If you have it you can loop trough it setting a workbook as the name of each file.

Es.

Dim x as integer
Dim selection, nameofthefile as variant
Dim wk1 As Workbook
Dim sh1 As Worksheet    
Dim wk2 As Workbook
Dim sh2 As Worksheet

Set wk1 = Workbooks("this file.xlsx")
Set sh1 = wk1.Worksheet("name of the sheet with the list")
For x = 1 To 900 
If Cells(x , 1) <> "" Then
 selection = Cells(x , 1)
 nameofthefile = "Your path" & ".xlsx"
 Workbooks.Open Filename:=nameofthefile
 Set wk2 = Workbooks(selection & ".xlsx")
 Set sh2 = wk2.Worksheets("Name of the sheet you want to use")
 sh1.activate
 Range("B45:B51").Select
Application.CutCopyMode = False
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("M45:M48").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("C45:C51").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Range("N45:N48").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Application.CutCopyMode = False
wk1.Close SaveChanges:=True
End If
Next
Set wk2 = Nothing
Set sh2 = Nothing

it's only an example but it should work with a list. Tell us more

How do I loop over Excel files in a shared drive and make/save changes on each of them?

1 Answers1