Ver Mensaje Individual
  #3 (permalink)  
Antiguo 23/02/2011, 10:20
Hobitt
 
Fecha de Ingreso: octubre-2006
Ubicación: Xoxocotla, Morelos Mexico
Mensajes: 243
Antigüedad: 17 años, 6 meses
Puntos: 0
Respuesta: cambiar delimitador de campos archivos csv

Hola mrocf:

Gracias por la idea me ayudo de mucho y finalmente lo deje mas o menos asi. espero esto le sirva alguien más.

Sub save_file()
Dim ren As String ' variable para el ultimo renglon
Dim nam_file As String ' variable para el nombre del archivo
Dim path_file As String ' variable para la ruta en donde ser guardara
Dim fech_file As String ' variable para la fecha que se asiganra al nombre del archivo
Dim hoja_file As String ' variable para el nombre de la hoja
Dim n As Integer ' variable para cambiar el nombre del archivo
Dim urow As Integer ' variable para la ultima celda con a concatenar
Dim c As Integer ' contador para concatenar cada fila

hoja_file = ActiveSheet.Name 'nombre de la hoja
fech_file = Format(Now, "yymmdd") ' extrae el dia en que se insertaran los FN
path_file = ActiveWorkbook.Path ' la ruta del libro
nam_file = path_file + "\" + hoja_file + "_" + fech_file & ".csv" ' asigna el nombre que debara tener el archivo

Range("A1").Select ' se coloca en la primera celda
Selection.End(xlDown).Select ' se va a la ultima celda

ucel = ActiveCell.Address ' le da la direccion de la ultima celda
urow = Range(ucel).Row
If ucel = "$A$1048576" Then ' si la hoja esta vacia termina la macro sin guardar nada
Exit Sub
End If

For c = 1 To urow Step 1
Range("F" & c).Value = Range("A" & c).Value & "|" & Range("B" & c).Value & "|" & Range("C" & c).Value & "|" & Range("D" & c).Text & "|" & Range("E" & c).Text
Next

Range("F1:F" & urow).Copy

Workbooks.Add
Range("a1").PasteSpecial

Do Until Dir(nam_file) = ""
n = n + 1
nam_file = path_file + "\" + hoja_file + "_" + fech_file & "_" & n & ".csv"
Loop

ActiveWorkbook.SaveAs Filename:=nam_file, FileFormat:=xlCSVMSDOS, CreateBackup:=False
ActiveWorkbook.Close False

Columns("F:F").Select
Selection.Delete Shift:=xlToLeft

End Sub