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

Respuesta
1

¿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 With

Las 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 Sub

Para 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 Sub

Andy

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas