Thanks Thanks:  0
Likes Likes:  0
Results 1 to 3 of 3

Thread: VBA to add a new column to 200+ workbooks

  1. #1
    Board Regular
    Join Date
    Apr 2002
    Location
    Surrey, United Kingdom
    Posts
    75
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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

  2. #2
    Rest in Peace
    Join Date
    Feb 2002
    Posts
    1,582
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    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


    [ This Message was edited by: Dave Hawley on 2002-04-08 03:53 ]

  3. #3
    Board Regular
    Join Date
    Apr 2002
    Location
    Surrey, United Kingdom
    Posts
    75
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default

    Thanks Dave, I've just run a test on a couple of the files and it works perfectly.

    Many thanks again,

    Nibbles

Some videos you may like

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •