VBA – Exportar Rango a CSV (Archivo de Texto Delimitado)

Guardar Rango a Archivo CSV

Solución #670 sobre cómo exportar un rango a un archivo de texto delimitado.

Esta es una alternativa práctica para usar la forma predeterminada de Excel de guardar la hoja de trabajo como un archivo de texto o un archivo delimitado CSV al elegir «guardar como» cuando:

1. Utiliza una plantilla y sólo desea exportar los datos excluyendo encabezados y otras cosas varias

2. Del mismo modo, es posible que sólo desee exportar parte de un conjunto de datos

3. Desea guardar el archivo con un delimitador personalizado que puede ser exclusivo de su aplicación.

Si necesita hacer 1, 2 o 3 cosas, una función como la siguiente puede serle útil. Acepta un rango para exportar, la ubicación para guardar el archivo y el delimitador con el que desea separar los datos, y luego guarda los datos según lo especificado.

Así es como se llama a la función ExportRange:

Sub CallExport()

  'Exportar Rango(Rango,donde,delimitador)
  Call ExportRange(Hoja1.Range("A1:C20"), "C:mark.txt", ",")

End Sub

Primero le dices a la función el rango que quieres exportar, luego dónde exportarlo, que el delimitador a usar. También necesitará la función ExportRange, aquí está:

Function ExportRange(WhatRange As Range, _
        Where As String, Delimiter As String) As String

    Dim HoldRow As Long    'prueba de nueva variable de fila
    HoldRow = WhatRange.Row
    
    Dim c As Range
    
    'bucle a través de la variable de rango
    For Each c In WhatRange
        If HoldRow <> c.Row Then
            'añadir salto de línea y eliminar delimitador extra
            ExportRange = Left(ExportRange, Len(ExportRange) - 1) _
                              & vbCrLf & c.Text & Delimiter
            HoldRow = c.Row
        Else
            ExportRange = ExportRange & c.Text & Delimiter
        End If
    Next c
    
    'Recortar delimitador extra
    ExportRange = Left(ExportRange, Len(ExportRange) - 1)
    
    'Eliminar el archivo si ya existe
    If Len(Dir(Where)) > 0 Then
        Kill Where
    End If
    
    Open Where For Append As #1    'escribir el nuevo archivo
    Print #1, ExportRange
    Close #1
End Function