VBA to add a new column to 200+ workbooks

Nibbles

Board Regular
Joined
Apr 1, 2002
Messages
75
Hi!

I have 200+ workbooks of identical format. They all comprise 3 worksheets. I need to add a column called 'Status' to the second and third sheet of each workbook in a specific location. I have a seperate worksheet containing the full path for each of the 200+ workbooks. I have the following macro to insert the columns:

Sub Insert_Columns()
Sheets("Sheet2").Select
Columns("AA:AA").Select
Selection.Insert Shift:=xlToRight
Range("AA1").Select
ActiveCell.FormulaR1C1 = "Status"
Range("A1").Select
Sheets("Sheet3").Select
Columns("T:T").Select
Selection.Insert Shift:=xlToRight
Range("T1").Select
ActiveCell.FormulaR1C1 = "Status"
Range("A1").Select
Sheets("Sheet1").Select
Range("A1").Select
End Sub

Could anyone please provide some help as to how to run this macro on each of the filenames I have in my list - otherwise it could take some time!!

Many thanks,

Nibbles
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Hi Nibbles


If your list of Workbook names are in Column A try this:

Code:
Sub Insert_Columns()
Dim rCells As Range
Dim strBook As String

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each rCells In ThisWorkbook.Worksheets(1).Range _
                ("A1", ThisWorkbook.Worksheets(1).Range("A65536").End(xlUp))
   strBook = "C:/MyDocuments/" & rCells.Value
   Workbooks.Open Filename:=strBook, UpDateLinks:=0

     Sheets("Sheet2").Columns("AA:AA").EntireColumn.Insert
     Sheets("Sheet2").Range("AA1") = "Status"
     Sheets("Sheet3").Columns("T:T").EntireColumn.Insert
     Sheets("Sheet3").Range("T1") = "Status"

  ActiveWorkbook.Close SaveChanges:=True

Next rCells

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub


Just alter references to suit.

_________________
Kind Regards
Dave Hawley
OzGrid Business Applications
Microsoft Excel/VBA Training
OzGrid.BusApp.170x45.gif

This message was edited by Dave Hawley on 2002-04-08 03:53
 
Upvote 0
Thanks Dave, I've just run a test on a couple of the files and it works perfectly.

Many thanks again,

Nibbles
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,237
Members
448,555
Latest member
RobertJones1986

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top