Separar un archivo csv en 2 con macros
Tengo una macro que elimina todas las celdas vacías de la columna F del Libro 2 hoja1, quisiera que mediante un código vba obtener esas celdas vacías y pegarlos en otro libro con el mismo nombre
¿Se puede hacer?
Ojala me pudieran decir como
1 respuesta
¿Puedes aclarar a que te refieres con obtener esas celdas vacías? ¿Cuál seria el punto de copiar celdas vacías a otro libro?
Hola Andy Machin,!
Si perdon, no me explique correctamente.
Del libro2 hoja1 en la columna A hasta columna F están llenas de información con muchas filas , pero en la columna F en algunas celdas están vacías. La macro que tengo recorre la columna F encuentra las celdas vacías y elimina toda la fila.
Mi petición es que si hay alguna manera mediante código VBA de crear un nuevo libro y copiar todas las filas de A-E donde F es vacío.
Quedando así El libro2 con columnas de A a F(sin celdas vacías) y el LibroNuevo con columnas de A a E.
Gracias! Espero si me haya explicado mejor
Quieres pasar las filas, ¿y luego borrarlas con la macro que ya tienes para borrar? Si es así, podrías compartir la macro, ya que en ella misma se hace el proceso de pasar las filas al otro libro, solo hay que modificarla.
si exacto pasarlas y despues borrarlas.
La macro es la siguiente
Dim uf as Long
Application.ScreenUpdating = 0
uf = Range("A" & Rows.Count).End(xlUp).Row
With Range("F1:F" & uf)
.AutoFilter Field:=1, Criteria1:=" "
.Offset(1).Resize(.Rows.Count).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
Application.ScreenUpdating = 1
Ya veo, no necesitas usar AutoFiltro si las celdas están realmente vacías ya que SpecialCells tiene un argumento para ellas y es mejor y más rápido. En general la idea es esta:
Dim otroLibro as Workbook: Set otroLibro = Workbooks("El otro Libro.xls")
Dim uF As Long: uF = ThisWorkbook.Range("A" & Rows.Count).End(xlUp).Row
With Thisworkbook.Range("f1:f" & uF).SpecialCells(xlCellTypeBlanks).EntireRow
.Copy otroLibro.Sheet1.Range("A1")
.Delete
End WithLas dos cosas se hacen juntas de una vez. Si me das mas detalles sobre el otro libro te termino el codigo.
Hola! Disculpa la hora, probe la macro e hice los cambios de los nombres de los archivos pero me marca error en Range
Jajaja si! Disculpa, ahora lo noto, es que esa respuesta te la escribí desde el celular, sin probarla ni nada.
No es posible referirse al Rango de un libro, sin antes referirse a la hoja. Ese debe ser el error.
Aquí esta corregido:
Sub mover()
Dim otroLibro As Workbook: Set otroLibro = Workbooks("El otro Libro.xls")
Dim uF As Long: uF = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
With ThisWorkbook.Sheets(1).Range("C1:C" & uF).SpecialCells(xlCellTypeBlanks).EntireRow
.Copy otroLibro.Sheets(1).Range("A1")
.Delete
End With
End SubPara que el código funcione el otro libro debería estar abierto.
No se si el otro libro ya existe o quieres crearlo desde el código o que el código abra uno.
Gracias! La probé y esta si funciona perfecto.
Si me gustaría crear la hoja con código pero el libro y la hoja deben de tener el mismo nombre, ¿cómo seria?
Hey Mireya (perdon la demora, hoy tuve un día largo),
Aquí te dejo la macro lo mas completa posible. Cuando se ejecuta, lo primero que hace es abrir la ventana de Guardar Como, para que elijas como quieres guardar el nuevo libro que se va a crear. Te he puesto 3 opciones de formato: xls, xlsx, y csv ya que en el titulo de tu pregunta se menciona csv. Si necesitas mas formatos, déjame saber.
Una vez que escribas el nombre y elijas el formato, el resto se hace (siempre y cuando hayan celdas vacías en la columna F claramente)
El nuevo libro tendrá una hoja con el mismo nombre que le diste al libro en la ventana de Guardar Como.
Sub mover()
Application.ScreenUpdating = False
Dim otroLibro As Workbook: Dim uF As Long: Dim fRng As Range
Dim brokenR() As String
Dim fName As String, fExtension As String, fExt As Long, fFormat As Long
Dim fRuta As Variant
fRuta = Application.GetSaveAsFilename(FileFilter:= _
"Archivos Excel (*.xlsx), *.xlsx," & _
" Archivos Excel compatible 97-2003 (*.xls), *.xls," & _
" CSV (*.csv), *.csv", Title:="Guardar como...", _
InitialFileName:=ThisWorkbook.Path & "\")
If fRuta <> False Then
uF = ThisWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
brokenR = Split(fRuta, "\")
fName = brokenR(UBound(brokenR))
fExt = Len(fName) - InStrRev(fName, ".") + 1
fExtension = Right(fName, fExt - 1)
fName = Left(fName, Len(fName) - fExt)
Select Case fExtension
Case "xls"
fFormat = 56
Case "xlsx"
fFormat = 51
Case "csv"
fFormat = 6
End Select
On Error Resume Next
Set fRng = ThisWorkbook.Sheets(1).Range("F1:F" & uF).SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not fRng Is Nothing Then
Set otroLibro = Workbooks.Add
With fRng.EntireRow
.Copy otroLibro.Sheets(1).Range("A1")
.Delete
End With
otroLibro.Sheets(1).Name = fName
otroLibro.SaveAs Filename:=fRuta, FileFormat:=fFormat
otroLibro.Close
End If
End If
Application.ScreenUpdating = True
End SubAndy
