excel - txt - macro para importar datos de un libro a otro

Excel: macro para exportar la hoja de cálculo como archivo CSV sin dejar mi hoja actual de Excel

Question

Hay muchas preguntas aquí para crear una macro para guardar una hoja de cálculo como un archivo CSV. Todas las respuestas utilizan SaveAs, como esta de SuperUser. Básicamente dicen que para crear una función VBA como esta:

Sub SaveAsCSV()
ActiveWorkbook.SaveAs FileFormat:=clCSV, CreateBackup:=False
End Sub

Esta es una gran respuesta, pero quiero hacer una exportación en lugar de Guardar como . Cuando se ejecuta el SaveAs, me causa dos molestias:

• Mi archivo de trabajo actual se convierte en un archivo CSV. Me gustaría continuar trabajando en mi archivo .xlsm original, pero exportar el contenido de la hoja de trabajo actual a un archivo CSV con el mismo nombre.
• Aparece un cuadro de diálogo que me pide que confirme que me gustaría volver a escribir el archivo CSV.

¿Es posible simplemente exportar la hoja de trabajo actual como un archivo, pero continuar trabajando en mi archivo original?

Answer 1

@NathanClement fue un poco más rápido. Sin embargo, aquí está el código completo (un poco más elaborado):

Option Explicit
Public Sub ExportWorksheetAndSaveAsCSV()
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
Set shtToExport = ThisWorkbook.Worksheets("Sheet1") ''Sheet to export as CSV
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False ''Possibly overwrite without asking
wbkExport.SaveAs Filename:="C:/tmp/test.csv", FileFormat:=xlCSV
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub

Answer 2

Casi lo que quería @Ralph. Su código tiene algunos problemas:

1. exporta solo la hoja codificada llamada "Hoja1";
2. siempre se exporta al mismo archivo temporal, sobrescribiéndolo;
3. se ignora el carácter de separación de caracteres.

Para resolver estos problemas y cumplir con todos mis requisitos, he adaptado el código de aquí . Lo he limpiado un poco para hacerlo más legible.

Option Explicit
Sub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "/" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

Todavía hay algunas cosas pequeñas con el código anterior que deberías notar:

1. .Close y DisplayAlerts=True debería estar en una cláusula finally, pero no sé cómo hacerlo en VBA
2. Funciona solo si el nombre de archivo actual tiene 4 letras, como .xlsm. No funcionaría en archivos .xls excel. Para las extensiones de archivo de 3 caracteres, debe cambiar el - 5 a - 4 al configurar MyFileName.
3. Como efecto colateral, su portapapeles será sustituido por el contenido de la hoja actual.

Editar: poner Local:=True para guardar con mi delimitador CSV de configuración regional.

Answer 3

Como comenté, hay algunos lugares en este sitio que escriben el contenido de una hoja de cálculo a un CSV. Este y este para señalar solo dos.

Abajo esta mi version

• explícitamente busca "," dentro de una celda
• También utiliza UsedRange , porque desea obtener todos los contenidos de la hoja de trabajo
• Utiliza una matriz para hacer bucles, ya que esto es más rápido que recorrer las celdas de la hoja de cálculo
• No usé rutinas FSO, pero esta es una opción

El código ...

Sub makeCSV(theSheet As Worksheet)
Dim iFile As Long, myPath As String
Dim myArr() As Variant, outStr As String
Dim iLoop As Long, jLoop As Long
myPath = Application.ActiveWorkbook.Path
iFile = FreeFile
Open myPath & "/myCSV.csv" For Output Lock Write As #iFile
myArr = theSheet.UsedRange
For iLoop = LBound(myArr, 1) To UBound(myArr, 1)
outStr = ""
For jLoop = LBound(myArr, 2) To UBound(myArr, 2) - 1
If InStr(1, myArr(iLoop, jLoop), ",") Then
outStr = outStr & """" & myArr(iLoop, jLoop) & """" & ","
Else
outStr = outStr & myArr(iLoop, jLoop) & ","
End If
Next jLoop
If InStr(1, myArr(iLoop, jLoop), ",") Then
outStr = outStr & """" & myArr(iLoop, UBound(myArr, 2)) & """"
Else
outStr = outStr & myArr(iLoop, UBound(myArr, 2))
End If
Print #iFile, outStr
Next iLoop
Close iFile
Erase myArr
End Sub

Answer 4

De acuerdo con mi comentario en la publicación @neves, mejoré ligeramente esto al agregar xlPasteFormats así como a la parte de valores, por lo que las fechas aparecen como fechas: en su mayoría, guardo como CSV para los extractos bancarios, por lo que necesito fechas.

Sub ExportAsCSV()
Dim MyFileName As String
Dim CurrentWB As Workbook, TempWB As Workbook
Set CurrentWB = ActiveWorkbook
ActiveWorkbook.ActiveSheet.UsedRange.Copy
Set TempWB = Application.Workbooks.Add(1)
With TempWB.Sheets(1).Range("A1")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With
''Dim Change below to "- 4" to become compatible with .xls files
MyFileName = CurrentWB.Path & "/" & Left(CurrentWB.Name, Len(CurrentWB.Name) - 5) & ".csv"
Application.DisplayAlerts = False
TempWB.SaveAs Filename:=MyFileName, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
TempWB.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub