Automatically Create an column

[tajulit]

Hi Experts,
I Have about 2000 excel file. I want all 2000 files automatically create an column & fill up those cell with Own excel file name. For example if i have a file named "new bikes" with 250 rows, then I need create a column A automatically & fill up 250 rows with "new bikes".


Advance Thanks for your Cooperation.
Tajul

 

[Yongle]

Re: Excel Help: Automatically Create an column

You did not tell us if all the workbooks are in the same folder
The code will stop if a file cannot be opened (if any are password protected etc) or sheet1 is protected etc

This code
- alows the user to select a folder
- opens workbooks in that folder (based on all extensions beginning with xls)
- determines last record based on last entry in column A in first sheet
- inserts a new column in first sheet
- adds name of file starting in A2

Place all code in the same module

Option Explicit
Sub InsertColumnA()

    Dim wb As Workbook, ws As Worksheet, rng As Range
    Dim myPath As String, myFile As String, myExtension As String
    
    myPath = GetMyPath
    myExtension = "*.xls*"
    myFile = Dir(myPath & "\" & myExtension)
    OptimiseSettings False
    
    Do While myFile <> ""
        Set wb = Workbooks.Open(Filename:=myPath & "\" & myFile)
        DoEvents
        Set ws = wb.Sheets(1)
        With ws
            .Columns("A").Insert Shift:=xlToRight
            Set rng = .Range("B" & Rows.Count).End(xlUp).Offset(, -1)
            .Range("A2", rng) = Left(wb.Name, InStrRev(wb.Name, ".") - 1)  
            .Range("A1") = "Workbook"
            .Columns("A").AutoFit
        End With
        wb.Close SaveChanges:=True
        DoEvents
        myFile = Dir
    Loop
    
    OptimiseSettings (True)
End Sub

Private Sub OptimiseSettings(Optimise As Boolean)
    With Application
        .EnableEvents = Optimise
        .ScreenUpdating = Optimise
        .Calculation = xlCalculationManual
        If Optimise = False Then .Calculation = xlCalculationAutomatic
    End With
End Sub

Private Function GetMyPath()
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select A Target Folder"
        .AllowMultiSelect = False
        If .Show <> -1 Then GoTo TheEnd
        GetMyPath = .SelectedItems(1)
    End With

TheEnd:
    If GetMyPath = "" Then
        MsgBox "Cancelled by User"
        End
    End If
End Function

 

[tajulit]

Re: Excel Help: Automatically Create an column

Hi Yongle

Thanks a lot. It works fine.

 

[Yongle]

Re: Excel Help: Automatically Create an column

thanks for the feedback