Cycle a vba function through all workbooks in a folder

Question

I want to cycle through all workbooks in a folder, extract worksheets named "Sheet Name", and save them as .csv files with the name of the file from which they originated. What's quick way to do this?

Example of vba function in question:

Sub Sheet_SaveAs()
  Dim wb As Workbook
  Sheets("Sheet Name").Copy  
  Set wb = ActiveWorkbook       
  With wb
  .SaveAs ThisWorkbook.Path & "\" & ThisWorkbook.name, FileFormat:=xlCSV
  '.Close False
  End With
End Sub

Many thanks for looking

EDIT: Not a duplicate because I am working on extracting sheets from multiple workbooks, and not multiple worksheets from a single workbook.

EDIT2: thank you, everyone.

possible duplicate of Saving excel worksheet to CSV files with filename+worksheet name using VB — skkakkar
I think you're right, although I tried the code marked as answer, and I get an error that my file may be corrupted or read only, which I wasn't getting previously. — user53423103981023
•you can't used a named constant such as xlCSV in vbscript, hence the use of 6 below as the CSV format. ~For Each objws In objWB.Sheets objws.Copy objExcel.ActiveWorkbook.SaveAs objWB.Path & "\" & objws.Name & ".csv", 6 objExcel.ActiveWorkbook.Close False Next~ and then try again — skkakkar
please try @brettdj code in the post <stackoverflow.com/questions/8434994/…> I have tested it earlier, it works. — skkakkar
The solutions you're referring me to don't work on copying across multiple workbooks in a folder; I think they are for multiple worksheets in a workbook. — user53423103981023

brettdj brettdj · Accepted Answer · 2015-09-28T06:33:58

Something like this.

Change this path to suit your folder

strFolder = "c:\temp"

code

Sub LoopThroughFiles()
    Dim Wb As Workbook
    Dim ws As Worksheet
    Dim strFolder As String
    Dim strFile As String

    strFolder = "c:\temp"
    strFile = Dir(strFolder & "\*.xls*")

    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With

    Do While Len(strFile) > 0
     Set Wb = Workbooks.Open(strFolder & "\" & strFile)
     Set ws = Nothing
     On Error Resume Next
     Set ws = Wb.Sheets("Sheet Name")
     On Error GoTo 0
     If Not ws Is Nothing Then ws.SaveAs Left$(Wb.FullName, InStrRev(Wb.FullName, ".")) & "csv", FileFormat:=xlCSV
     Wb.Close False
        strFile = Dir
    Loop

     With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
End Sub

Cycle a vba function through all workbooks in a folder

1 Answers