Hola a todos, quisiera solicitar su ayuda con un problema que tengo generalmente trabajo con varios archivos de excel que me envían por el trabajo y muchos vienen con filas y columnas en blanco entre medio de los datos, por lo cual busque en Internet unos códigos para eliminar filas y columnas vacías lo cual funciona el problema es como. Me explico las macros que encontré que son dos independientes y esta bien por que algunas veces elimino solo las filas y otras las columnas el detalle es que buscan hasta la ultima fila y columna lo cual hace que el computador se me pegue y tengo que esperar que termine para poder seguir trabajando pero algunas veces el tiempo es demasiado.

Existe alguna macro que busque hasta la ultima fila o columna con datos y elimine la filas o columnas en blanco y no tener que estar buscando hasta la ultima fila o columnas

y mi otra consulta relacionada con lo mismo existe una macro que elimine celdas y filas en blanco al final del documento, esto es porque tengo muchas veces que eliminarlas de manera manual para que el libro pese menos y primero elimino las filas vacías después del ultimo dato en la celda hasta la ultima fila y lo mismo hago con las columnas .

desde ya amigos agradezco su generosa ayuda.

PD: Trabajo con excel 2010, no subo un archivo porque los archivos con los que trabajo son todos diferentes.

Hola,Esta macro elimina Filas Y columnas vacías la puedes adaptar a tus necesidades.

Saludos...

Sub DeleteEmptyRowsAndColumns() LastRow = ActiveSheet.UsedRange.Row - 1 + _ ActiveSheet.UsedRange.Rows.Count Application.ScreenUpdating = False For r = LastRow To 1 Step -1 If Application.CountA(Rows®) = 0 Then Rows®.Delete Next r LastColumn = ActiveSheet.UsedRange.Column - 1 + _ ActiveSheet.UsedRange.Columns.Count Application.ScreenUpdating = False For c = LastColumn To 1 Step -1 If Application.CountA(Columns©) = 0 Then Columns©.Delete Next c End Sub

Yo primero revisaria el porque tienes tantas filas y columnas vacias al final de tu tabla?, las filas y columnas que no has usado no son consideradas por excel, así que si el archivo pesa porque tienes filas o columnas "usadas" pero vacias es porque las estas agregando de alguna manera y tal vez allí tengas el problema, suerte

He añadido unos adornos a la macro de kruciare:

Sub DeleteEmptyRowsAndColumns()


Dim Rango As Range

Application.ScreenUpdating = False


'--------------------------- Filas

LastRow = ActiveSheet.UsedRange.Row + _

          ActiveSheet.UsedRange.Rows.Count - 1

For r = 1 To LastRow

   If Application.CountA(Rows(r)) = 0 Then

      If Rango Is Nothing = True Then

         Set Rango = Rows(r)

      Else

         Set Rango = Application.Union(Rango, Rows(r))

      End If

   End If

Next

If Rango Is Nothing = False Then

   MsgBox "*** Eliminadas " & Rango.Rows.Count & " filas ***"

   Rango.Delete

   filas = True

End If


'--------------------------- Columnas

Set Rango = Nothing

LastColumn = ActiveSheet.UsedRange.Column + _

             ActiveSheet.UsedRange.Columns.Count - 1

For c = 1 To LastColumn

   If Application.CountA(Columns(c)) = 0 Then

      If Rango Is Nothing = True Then

         Set Rango = Columns(c)

      Else

         Set Rango = Application.Union(Rango, Columns(c))

      End If

   End If

Next

If Rango Is Nothing = False Then

   MsgBox "*** Eliminadas " & Rango.Columns.Count & " columnas ***"

   Rango.Delete

Else

   If filas = False Then

      MsgBox "*** No hay filas ni columnas en blanco al final del rango ***", vbInformation

   End If

End If

End Sub

[/CODE]

agradeciendo a todos sus comentarios y ayuda le comento que aun no he podido solucionar mi problema así que mejor le dejo un archivo a modo de ejemplo para ver si me pueden ayudar un poco mas.

muchas veces por mi trabajo me envían archivos los cuales tiene formato condicional y otras cosas en todas las filas y columnas del libro excel cuando no creo que se ocupen todas las filas y columnas algunos lo hacen por flojera para no seleccionar las celdas necesarias lo que genera un aumento en el peso del libro la idea es que la macro seleccione siempre desde la celda A:1 hasta la ultima celda con valor y elimine todas las filas y columnas vacías fuera de este rango así se eliminarían todos los formatos de las filas y columnas vacías sin modificar el rango con valores, se que es un poco complejo lo que pido pero si se pudiera lo agradecería mucho......

quería adjuntar un archivo de ejemplo pero no sale la opción adjuntar archivo espero haber podido explicarme bien.

Besos...

Ejemplo.rar

Tal vez te sirva esta opcion:

Más sobre del comando Ir A - Especial de Excel ~ JLD Excel en Castellano - Usar Microsoft Excel eficientemente

El tema va por donde apunta Armando:

Esta macro debería funcionar:

Sub DeleteEmptyRows()

Dim Rango As Range

Application.ScreenUpdating = False

LastRow = Range("A1").SpecialCells(xlCellTypeAllFormatConditions).Rows.Count

For r = 1 To LastRow

   If Application.CountA(Rows(r)) = 0 Then

      If Rango Is Nothing = True Then

         Set Rango = Rows(r)

      Else

         Set Rango = Application.Union(Rango, Rows(r))

      End If

   End If

Next

If Rango Is Nothing = False Then

   MsgBox "*** Eliminadas " & Rango.Rows.Count & " filas ***"

   Rango.Delete

   filas = True

End If

End Sub[/CODE]

Loretito, no se si ya solucionaste tu problema pero te dejo esta macro que encontré por Internet y hace mas menos lo que tu deseas por lo que entendí en tu archivo te guarda una copia reducida en mis documentos lo ideal seria que solicitara donde guardar la copia pero no he podido modificar la macro para que solicite el lugar a guardar.

la macro fue creada por Mauricio Robayo

Sub Limpiar_rangos()    

    Dim hj As Excel.Worksheet

    Dim copia$, ffin&, cfin&, TI&, TF&


    copia = crear_copia(ActiveWorkbook)

    MsgBox "Se ha creado una copia: " & vbLf & copia, vbInformation


    With ActiveWorkbook

        TI = VBA.FileLen(.FullName)

        For Each hj In .Worksheets

            ffin = 1

            cfin = 1

            With hj

                On Error Resume Next

                ffin = .UsedRange.Find(what:="*", _

                                       LookIn:=xlFormulas, _

                                       SearchOrder:=xlByRows, _

                                       SearchDirection:=xlPrevious).Row

                cfin = .UsedRange.Find(what:="*", _

                                       LookIn:=xlFormulas, _

                                       SearchOrder:=xlByColumns, _

                                       SearchDirection:=xlPrevious).Column

                On Error GoTo 0

                If .ProtectContents Then

                    If MsgBox("La hoja " & .Name & " se encuentra protegida." & vbLf & vbLf & _

                              "No se podrán limpiar los rangos de esta hoja a menos que se desproteja." _

                              & vbLf & vbLf & "¿Desea desprotegerla antes de continuar?", vbYesNo, _

                              "¡Hoja protegida!") = vbYes Then

                        If Desproteger(hj) Then

                            Limpiar hj, ffin, cfin

                        Else

                            MsgBox "No se ha desprotegido la hoja.", vbCritical, "¡Clave incorrecta!"

                        End If

                    End If

                Else

                    Limpiar hj, ffin, cfin

                End If

            End With

        Next hj

        .Save

        TF = VBA.FileLen(.FullName)

    End With


    MsgBox "Tamaño original: " & VBA.Format(TI, "#,##0") & " bytes." & vbLf & vbLf & _

           "Tamaño final: " & VBA.Format(TF, "#,##0") & " bytes." & vbLf & vbLf & _

           "El archivo se redujo en: " & VBA.Format(TI - TF, "#,##0") & " bytes" & _

           " (" & VBA.FormatPercent(Abs(TI / TF - 1), 2) & ")."


End Sub

Private Function Desproteger(ByVal hj As Excel.Worksheet) As Boolean


    On Error Resume Next

    hj.Unprotect

    Desproteger = Not VBA.CBool(Err.Number)

    On Error GoTo 0


End Function

Private Sub Limpiar(ByVal hj As Excel.Worksheet, ByVal ffin As Long, ByVal cfin As Long)


    With hj

        With .Range(.Cells(ffin + 1, 1), .Cells(.Rows.Count, 1)).EntireRow

            If .MergeCells = False Then .Clear

        End With

        With .Range(.Cells(1, cfin + 1), .Cells(1, .Columns.Count)).EntireColumn

            If .MergeCells = False Then .Clear

        End With

    End With


End Sub

Function crear_copia(ByVal Libro As Excel.Workbook) As String


        With Libro

            .Save

            crear_copia = .Path & Application.PathSeparator & VBA.Format(VBA.Now, "d-m-yy h-mm ") & .Name

            .SaveCopyAs crear_copia

        End With


End Function[/CODE]

amigos gracias por todos sus aportes, kruciare tu macro es justo lo que buscaba con la diferencia que esta me hace una copia con lo que necesito pero es mejor eso y eliminar el archivo original que estar eliminando formatos seleccionando filas y columnas muchas gracias a todos Besos.....

Por mi parte doy el tema por solucionado...Muchas gracias