Guardar de excel como txt

Estimado Dam, tu valiosa ayuda con este código me sirvió de mucho

Sub pasaratxt() 'Por.DAM

Application.ScreenUpdating = False

Application.DisplayAlerts = False

Set h1 = ActiveSheet mes = Month(Range("E2"))

ruta = ThisWorkbook.Path & "\"

Set l2 = Workbooks.Add

Set h2 = l2.ActiveSheet

h1.Range("A2:E50").Copy h2.Range("A1")

h2.SaveAs Filename:=ruta & mes & ".txt", _

FileFormat:=xlCSV, _

CreateBackup:=False

ActiveWorkbook.Close

Workbooks.Open ruta & mes & ".txt"

Cells.Replace What:=",", Replacement:="|"

ActiveWorkbook.Save

ActiveWindow.Close

Set h2 = Nothing

Set l2 = Nothing

Set h1 = Nothing

Application.ScreenUpdating = True

Application.DisplayAlerts = True

End Sub

Este código funciona a la perfección tal cmo necesito mi archivo, solo que quisiera que se abra un dialogo y yo ingresar el nombre del documento con el cual se va a aguardar, desde ya un millón de gracias

saludos

Jesús

1 Respuesta

Respuesta
1

Prueba con esta macro, te guarda el archivo con extensión .txt, solamente escribe el nombre, la macro te sugiere el mes como nombre.

Sub atxt()
'Por.DAM
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set h1 = ActiveSheet
    mes = Month(Range("E2"))
    ruta = ThisWorkbook.Path & "\"
    Set l2 = Workbooks.Add
        Set h2 = l2.ActiveSheet
            h1.Range("A2:E50").Copy h2.Range("A1")
            With Application.FileDialog(msoFileDialogSaveAs)
                .Title = "Guardar archivo como"
                .AllowMultiSelect = False
                .InitialFileName = mes
                .FilterIndex = 15
                If .Show Then
                    march = .SelectedItems(1)
                    march = Replace(.SelectedItems(1), ".csv", ".txt")
                    h2.SaveAs Filename:=march, FileFormat:=xlCSV
                    ActiveWorkbook.Close
                    Workbooks.Open march
                    Cells.Replace What:=",", Replacement:="|"
                    ActiveWorkbook.Save
                    ActiveWindow.Close
                End If
            End With
        Set h2 = Nothing
    Set l2 = Nothing
Set h1 = Nothing
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Si no quieres el nombre inicial, borra esta línea en la macro.

.InitialFileName = mes

Saludos. DAM
Si es lo que necesitas.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas