Copiar datos de una columna excel a un archivo TXT
Necesito copiar unos datos que se encuentran en una columna en excel, a un archivo TXT. La idea es que pinchando un botón, pueda crear un archivo TXT con los datos que tengo en una columna de un archivo excel. Gracias.
Respuesta de santiagomf
1
1
santiagomf, Más de 35 años en la informática y más de 20 trabajando con...
Aunque no he probado el código, creo que estará bien. Supongamos que tu botón se llama 'exportarColumnaE', el código que tendrías que poner es el siguiente: Option Explicit Private Sub exportarColumnaE_Click() exportarDatosEnFicheroTexto 5 ' La columna E es la número 5 End Sub Sub exportarDatosEnFicheroTexto(ByVal nCol As Integer) Dim sCol As String Dim nf As Integer ' Número del fichero de salida (para escribir el txt) Dim nLin As Long ' Número de línea a escribir Dim maxLin As Long ' Último número de línea a escribir Dim nomFich As String ' Nombre del fichero de salida Dim i As Integer Dim resp As Integer ' Transformamos el número de columna en la letra/s que le corresponde If nCol <= 26 Then sCol = Chr$(64 + nCol) Else sCol = Chr$(64 + Int((nCol - 1) / 26)) & _ Chr$(64 + ((nCol - 1) Mod 26) + 1) End If ' Buscamos la última fila con datos dentro de la columna indicada maxLin = ActiveCell.SpecialCells(xlLastCell).Row Do While Cells(maxLin, nCol) = "" And maxLin > 0 maxLin = maxLin - 1 Loop If maxLin = 0 Then resp = MsgBox("La columna a exportar está vacia. Si exporta los " & _ "datos el fichero estará igualmente vacío." & _ vbCrLf & vbCrLf & "¿Desea cancelar la exportación?", _ vbExclamation + vbYesNo) If resp = vbYes Then Exit Sub End If ' Construimos el nombre del fichero de salida (y comprobamos que no exista) i = 0 Do If i > 0 Then nomFich = ThisWorkbook.Path & "\col" & sCol & "_" & Format$(i, "000") & ".txt" Else nomFich = ThisWorkbook.Path & "\col" & sCol & ".txt" End If If Not existeFichero(nomFich) Then Exit Do i = i + 1 Loop ' Ahora abrimos el fichero y escribimos los datos en él nf = FreeFile ' Obtenemos un número de fichero que no se esté usando. Normalmente el 1 Open nomFich For Output As nf ' Apertura del fichero para salida For nLin = 1 To maxLin Print #nf, Cells(nLin, nCol) Next nLin Close nf MsgBox "Fichero Creado: " & nomFich End Sub Function existeFichero(ByVal nomFich As String) As Boolean Dim d As String On Error Resume Next d = Dir$(nomFich) If Err <> 0 Then d = nomFich ' Al haber dado error, diremos que sí existe el fichero On Error GoTo 0 existeFichero = (d <> "") End Function
Muchas gracias, es justo lo que necesito, funciona bien, solamente necesito algunas aclaraciones: En que parte de la función esta el directorio en donde quedara guardado el archivo, me explico yo necesito guardar el archivo en una carpeta que se encuentra en red llamada \\ASPS8FIN4\trabajo\Interplantas\ ; la idea es poder saber en que parte de la función se puedo modificar la carpeta, así a futuro si cambia la carpeta o necesito hacer otra macro para otras carpetas poder modificarla. Y lo ultimo el nombre del archivo se damos nosotros, si me puedes indicar también donde la puedo cambiar. Muchas Gracias.
La propiedad "ThisWorkbook.Path" devuelve el nombre de la carpeta en la cual está grabada nuestra hoja de cálculo. Si quieres que se almacene en otra carpeta, cambia la construcción del nombre del fichero modificando esa parte. En tu caso tendrías que poner algo así: ' Construimos el nombre del fichero de salida (y comprobamos que no exista) i = 0 Do If i > 0 Then nomFich = "\\ASPS8FIN4\trabajo\Interplantas\col" & sCol & "_" & Format$(i, "000") & ".txt" Else nomFich = "\\ASPS8FIN4\trabajo\Interplantas\col" & sCol & ".txt" End If If Not existeFichero(nomFich) Then Exit Do i = i + 1 Loop Esta es una forma de construir el nombre añadiéndole un número de versión. Si quieres que sea un nombre fijo tendrás que modificar esas líneas y tener en cuenta que, en caso de existir el fichero de texto, debería borrarlo antes de volver a crearlo.
Muchas gracias, ambas preguntas cumplían con mi requerimiento, no soy un experto en macros, pero si me gusta meterme en estos temas y mientras pueda contar con ustedes puedo realizar herramientas para agilizar mi trabajo.