Si lo acabo de contestar....
Pongo la solucion para todos.
'*******************************************************************************
'* ExportarRangoATexto
'* exporta a un archivo de texto el rango indicado como parámetro
'* Argumentos: strArchivoSalida => ruta completa del archivo de salida
'* strRango => rango de datos a exportar
'* strHoja => (opcional) nombre de la hoja que contiene los
'* datos a exportar
'* uso: ExportarRangoATexto "C:Temppp.txt", "B2:D8"
'* ESH 07/08/08 22:38
'* Si utilizas este codigo, respeta la autoría y los créditos
'*******************************************************************************
Public Sub ExportarRangoATexto(strArchivoSalida As String, strRango As String, Optional strHoja As String)
Dim bytArchivo As Byte, _
Celda As Range, _
lngColumnas As Long, _
strTexto As String, _
i As Long
' si no se pasa hoja presupongo que es la activa
On Error GoTo ExportarRangoATexto_TratamientoErrores
If strHoja = "" Then strHoja = ActiveSheet.Name
bytArchivo = FreeFile
' selecciono el rango de datos
Worksheets(strHoja).Range(strRango).Select
' cuento el número de columnas
lngColumnas = Selection.Columns.Count
' abro el archivo de salida
Open strArchivoSalida For Output As #bytArchivo
' recorro las celdas del rango
For Each Celda In Worksheets(strHoja).Range(strRango)
' meto en una variable el contenido de la celda y un tabulador
strTexto = strTexto & Celda & vbTab
i = i + 1
' al llegar a la ultima columna del rango envío los datos al archivo
If i = lngColumnas Then
Print #bytArchivo, Mid(strTexto, 1, Len(strTexto) - 1)
' reseteo variables
i = 0
strTexto = ""
End If
Next Celda
' cierro el archivo
Close #bytArchivo
ExportarRangoATexto_Salir:
On Error GoTo 0
Exit Sub
ExportarRangoATexto_TratamientoErrores:
MsgBox "Error " & Err & " en proc.: ExportarRangoATexto de Módulo: Módulo1 (" & Err.Description & ")", vbCritical + vbOKOnly, "ATENCION"
Resume ExportarRangoATexto_Salir
End Sub ' ExportarRangoATexto
