Excel VBA : Copy Sheet name to all cells till empty rows loop for all files in a folder

user_17166670 0
Viewed 32

I have a huge numbers of CSV file inside a folder, each file is with single sheet. I want to insert a column in all files before the “A” column with a column header. In that new column I want to copy the sheet name to all the cells till empty rows. I am success full with adding column along with column heading with following script, now I nee help to copy sheet names to the cells. ''' Sub LoopThroughFolder()

             Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
             Dim Rws As Long, Rng As Range


             Set Wb = ThisWorkbook

             MyDir = "C:\Users\Sanghita\Desktop\test\" 
             MyFile = Dir(MyDir & "*.CSV")    
             ChDir MyDir
             Application.ScreenUpdating = 0
             Application.DisplayAlerts = 0

             Do While MyFile <> ""
             Workbooks.Open (MyFile)
             Range("A1").EntireColumn.Insert
             Range("A1").Value = "Police force" 'New Column Name
             ActiveWorkbook.Save
             ActiveWorkbook.Close True
             MyFile = Dir()

             Loop

             End Sub

''''

excel
2 Answers

Try this. It will add the active sheet name to all cells in column A until it reaches the last row. Hopefully this is what you are looking for.

Sub LoopThroughFolder()

    Dim Wb As Workbook
    Dim MyFile As String, Str As String, MyDir As String
    Dim Rws As Long, Rng As Range
    Dim lr As Integer
    

    Set Wb = ThisWorkbook
    lr = Cells(Rows.Count, "A").End(xlUp).Row

    MyDir = "C:\Users\Sanghita\Desktop\test\"
    MyFile = Dir(MyDir & "*.CSV")
    ChDir MyDir
    Application.ScreenUpdating = 0
    Application.DisplayAlerts = 0

    Do While MyFile <> ""
    Workbooks.Open (MyFile)
             
    With ActiveSheet
        .Range("A1").EntireColumn.Insert
        .Range("A1").Value = "Police force" 'New Column Name
        .Range("A2:A" & lr).Value = ActiveSheet.Name
        .Save
        .Close True
    End With
                
    MyFile = Dir()

    Loop

End Sub
user_140354080

I have got the solution, Thanks Patrick for your help here is the code.

    Sub LoopThroughFolder()

      Dim MyFile As String, Str As String, MyDir As String, Wb As Workbook
      Dim Rws As Long, Rng As Range
      Dim ws As Worksheet
      Dim lr As Integer


       MyDir = "C:\Users\Sanghita\Desktop\test\" 'Your Directory
       MyFile = Dir(MyDir & "*.CSV")    
       ChDir MyDir
       Application.ScreenUpdating = 0
       Application.DisplayAlerts = 0

       Do While MyFile <> ""
       Workbooks.Open (MyFile)
        Range("A1").EntireColumn.Insert
        Range("A1").Value = "Police force" 'New Column Name
        
       lr = Cells(Rows.Count, "B").End(xlUp).Row
       Set ws = ActiveSheet
        Range("A2:A" & lr).Value = ws.Name
        ActiveWorkbook.Save
        ActiveWorkbook.Close True
        MyFile = Dir()
    
    
Loop

End Sub
user_171666700
Related