Home

Simple VBA help

%3CLINGO-SUB%20id%3D%22lingo-sub-1058378%22%20slang%3D%22en-US%22%3ESimple%20VBA%20help%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1058378%22%20slang%3D%22en-US%22%3E%3CP%3EGreetings%2C%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20this%20simple%20VBA%20Macro%20that%20coverts%20all%20the%20files%20in%20a%20workbook%20to%20individual%20CSV%20files.%20However%20i%20would%20like%20to%20get%20the%20workbook%20name%20to%20be%20a%20a%20part%20of%20the%20directory%20.%20Also%20is%20for%20the%20code%20to%20be%20retro%20fitted%20so%20that%20i%20can%20convert%20all%20the%20workbooks%20in%20the%20directory.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EPublic%20Sub%20SaveWorksheetsAsCsv()%3CBR%20%2F%3EDim%20xWs%20As%20Worksheet%3CBR%20%2F%3EDim%20xDir%20As%20String%3CBR%20%2F%3EDim%20folder%20As%20FileDialog%3CBR%20%2F%3ESet%20folder%20%3D%20Application.FileDialog(msoFileDialogFolderPicker)%3CBR%20%2F%3EIf%20folder.Show%20%26lt%3B%26gt%3B%20-1%20Then%20Exit%20Sub%3CBR%20%2F%3ExDir%20%3D%20folder.SelectedItems(1)%3CBR%20%2F%3EFor%20Each%20xWs%20In%20Application.ActiveWorkbook.Worksheets%3CBR%20%2F%3ExWs.SaveAs%20xDir%20%26amp%3B%20%22%5C%22%20%26amp%3B%20xWs.Name%2C%20xlCSV%3CBR%20%2F%3ENext%3CBR%20%2F%3EEnd%20Sub%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ECheers.%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1058378%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E
Highlighted
wfm365
Occasional Visitor

Greetings,

 

I have this simple VBA Macro that coverts all the files in a workbook to individual CSV files. However i would like to get the workbook name to be a a part of the directory . Also is for the code to be retro fitted so that i can convert all the workbooks in the directory.

 

Public Sub SaveWorksheetsAsCsv()
Dim xWs As Worksheet
Dim xDir As String
Dim folder As FileDialog
Set folder = Application.FileDialog(msoFileDialogFolderPicker)
If folder.Show <> -1 Then Exit Sub
xDir = folder.SelectedItems(1)
For Each xWs In Application.ActiveWorkbook.Worksheets
xWs.SaveAs xDir & "\" & xWs.Name, xlCSV
Next
End Sub

 

 

Cheers.