Macro que convierta texto en columnas en masivo
Necesito de su valioso aporte ante una dudas en macro.
Tengo varios archivos en extensión csv. Lo que se hace manualmente el convertir texto en columnas. Es decir, como todos los datos están en la columna A, voy a la cinta de opciones, elijo datos, luego convertir texto en columnas.
Foto como se abre el archivo csv
Asi lo dejo en columnas
Con una grabadora de macro puedo hacer este proceso para que me separe el texto en columna pero solo por un archivo.
Lo que se desea obtener:
Que tan factible hacerlo en masivo. Es decir, que si en una carpeta copio 30 archivos con extensión CSV una macro abra cada archivo, convierta el texto en columnas y los guarde en la misma carpeta pero como libro Excel. Ejemplo en la foto.( Ejemplo con 4 archivos) Todos deben quedar delimitados como en la foto anterior.
Espero se entienda la idea y me mantengo atento a sus gentiles comentarios.
Pega la macro que te generó la grabadora de macros, para ahorrar tiempo y yo te hago el resto. Hay que hacer un bucle por cada archivo en la carpeta y repetir el proceso para cada uno. Dependiendo la cantidad de archivos y la cantidad de contenido dentro de cada uno, puede tardar en ejecutarse mas o menos
Estimado Andy:
Te comparto la macro que me genero la grabadora por un archivo.
Sub Macro1()
'
'Juan Arenas
Application.ScreenUpdating = False
Cells.Select
Selection.Copy
Windows("Prueba Natura").Activate
ActiveSheet.Paste
Application.CutCopyMode = False
Cells.Select
Cells.EntireColumn.AutoFit
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1)), _
TrailingMinusNumbers:=True
Columns("A:A").Select
Selection.ColumnWidth = 14
Range("a1:ac1").EntireColumn.AutoFit
Range("a1:ac1").EntireRow.AutoFit
Range("A1").Select
MsgBox "terminado"
End Sub
Prueba esto, ajusta cualquier ruta o parámetro que sea necesario.
Son dos macros, una para recorrer la carpeta en busca de cada csv, luego llama a la otra macro que es la que se encarga de hacer el Texto en Columna. Y luego guarda el archivo como un .xls
La macro que ejecutas es esta:
Sub OpenFiles() Application.ScreenUpdating = False Application.DisplayStatusBar = False Application.EnableEvents = False Application.Calculation = xlCalculationManual Dim Carpeta As String: Carpeta = ThisWorkbook.Path & "\Archivos CSV\" Dim Archivo As String Dim EsteLibro As Workbook: Set EsteLibro = ThisWorkbook Dim OtroLibro As Workbook Dim NewFileName As String Archivo = Dir(Carpeta & "*.csv") Do While Archivo <> "" Set OtroLibro = Workbooks.Open(Carpeta & Archivo) Call RunTextToColumn NewFileName = Carpeta & Left(Archivo, Len(Archivo) - 3) & "xls" OtroLibro.SaveAs Filename:=NewFileName, FileFormat:=xlWorkbookNormal OtroLibro.Close Set OtroLibro = Nothing Archivo = Dir() Loop Application.ScreenUpdating = True Application.DisplayStatusBar = True Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic MsgBox "terminado" End Sub
Esa llama dentro a esta:
Sub RunTextToColumn()
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="|", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12 _
, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), _
Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array( _
25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1)), _
TrailingMinusNumbers:=True
Range("A1").Select
Cells.EntireColumn.AutoFit
End SubTe explico como funciona:
Las macros irían en un libro a parte, que funciona como una especie de controlador. Ese libro va a buscar en una carpeta que se llama "Archivos CSV" todos los archivos de formato .csv que se encuentren ahí. Los va a abrir, les va a aplicar el Texto en Columnas y lo va a guardar como .xls en esa misma carpeta.
A mí me ha funcionado perfecto.
Estimado:
No ha captado bien la idea, he creado una carpeta llamada "Archivos CSV" ahi he pegado los libros CSV.
La duda que me queda es que si el código inserto 2 módulos. Uno para Open File() y otro módulo para Sub RunTexTocolumn(). Luego ejecuto la primera, y llama automática a la otra? O tengo que hacer 2 macros por separado?
Así como lo he planteado al ejecutar el openFile() no me abre ningún libro, sale el mensaje terminado pero no realiza el proceso.
Sera que la ruta que creo la carpeta debe cambiarse, es esta:
C:\Users\juan.arenas\Desktop\Archivos CSV
Definitivamente hay algo que no estoy haciendo bien. Dime si en todo caso puedo enviarte mi libro en un correo.
Gracias de antemano por el apoyo.
Claramente debes ajustar la ruta en esta línea:
Dim Carpeta As String: Carpeta = ThisWorkbook.Path & "\Archivos CSV\"
ThisWorkbook.Path es la ruta donde esta el libro que contiene la macro, yo lo tenia hecho así, no significa que tu tengas que hacerlo así también, tu pones la ruta tuya. La idea es esta:
Dim Carpeta As String: Carpeta = "tu ruta aqui"
Dim Carpeta As String: Carpeta = "C:\Users\juan.arenas\Desktop\Archivos CSV\"
Es importante la ultima barra al final \
