Guardar hoja de cálculo Excel en archivos CSV con nombre de archivo + nombre de hoja de cálculo utilizando VB

Soy muy nuevo con la codificación VB, estoy tratando de guardar varias hojas de cálculo de archivos de Excel a CSV, no sé cómo hacer esto para varias hojas, pero he encontrado una manera de hacer para un solo archivo. He encontrado código en este sitio que son muy útiles para lo que estoy tratando de hacer, único problema es que los archivos se guardan con el nombre de la hoja de cálculo, pero estoy tratando de guardarlos con el archivo original y el nombre de la hoja de cálculo como filename_worksheet name, he intentado hacerlo yo mismo, pero seguir recibiendo error, ¿podría por favor aconsejar lo que estoy haciendo mal?

El código que estoy usando es el siguiente:

   Public Sub SaveWorksheetsAsCsv()

   Dim WS As Excel.Worksheet
   Dim SaveToDirectory As String

   Dim CurrentWorkbook As String
   Dim CurrentFormat As Long

   CurrentWorkbook = ThisWorkbook.FullName
   CurrentFormat = ThisWorkbook.FileFormat
   ' Store current details for the workbook
   SaveToDirectory = "H:\test\"
   For Each WS In ThisWorkbook.Worksheets
   WS.SaveAs SaveToDirectory & WS.Name, xlCSV
   Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub 
Solución

Creo que esto es lo que quieres...

Sub SaveWorksheetsAsCsv()

Dim WS As Excel.Worksheet
Dim SaveToDirectory As String

Dim CurrentWorkbook As String
Dim CurrentFormat As Long

CurrentWorkbook = ThisWorkbook.FullName
CurrentFormat = ThisWorkbook.FileFormat
' Store current details for the workbook
SaveToDirectory = "H:\test\"

For Each WS In Application.ActiveWorkbook.Worksheets
    WS.SaveAs SaveToDirectory & WS.Name, xlCSV
Next

Application.DisplayAlerts = False
ThisWorkbook.SaveAs Filename:=CurrentWorkbook, FileFormat:=CurrentFormat
Application.DisplayAlerts = True
' Temporarily turn alerts off to prevent the user being prompted
'  about overwriting the original file.

End Sub
Comentarios (10)

¿Es esto lo que está intentando?

Option Explicit

Public Sub SaveWorksheetsAsCsv()
    Dim WS As Worksheet
    Dim SaveToDirectory As String, newName As String

    SaveToDirectory = "H:\test\"

    For Each WS In ThisWorkbook.Worksheets
        newName = GetBookName(ThisWorkbook.Name) & "_" & WS.Name
        WS.Copy
        ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSV
        ActiveWorkbook.Close Savechanges:=False
    Next
End Sub

Function GetBookName(strwb As String) As String
    GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))
End Function
Comentarios (2)

La mejor manera de averiguarlo es grabar la macro y realizar los pasos exactos y ver qué código VBA que genera. a continuación, puede ir y reemplazar los bits que desea hacer genérico (es decir, nombres de archivo y esas cosas)

Comentarios (0)