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

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

''''

CodePudding user response：

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

CodePudding user response：

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