Error al borrar un rango vba

[joanlo]

Buenas Noches

Tengo el siguiente código, que almacena las referencias de las celdas en la Variable Rango, para posteriormente borrar el contenido de las celdas.

El problema es que al llegar a la parte del borrado del Rango me Arroja error 1004 en tiempo de ejecución.

Son aproximadamente 100 celdas las que debe borrar.

Sub Factura_LimpiarPlantilla()

Dim Rango

Plantilla = "Factura_Registro"

Setup = "Factura_Setup"

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

Sheets(Plantilla).Unprotect Clave

I = 2

Rango = ""

While Sheets(Setup).Cells(I, 3) <> ""

If Sheets(Setup).Cells(I, 5) = "SI" Then

Celda = Sheets(Setup).Cells(I, 3)

If Rango = "" Then Rango = Celda Else Rango = Rango & "," & Celda

End If

I = I + 1

Wend

Sheets(Plantilla).Range(Rango) = Empty

Sheets(Plantilla).Protect Clave

Application.Calculation = xlCalculationAutomatic

Application.ScreenUpdating = True

End Sub

[joanlo]

Bueno, al parecer excel no permite borrar mediante la propiedad Range = Empty hasta cierto número de celdas, por lo cual intenté usé 3 variables de rango para almacenar las celdas a borrar y funcionó.

Si alguien tiene una mejor solución se lo agradecería

[Antoni]

.

Sheets(Plantilla).Range(Rango) = Empty es perfectamente válido siempre que la variable Plantilla contenga el nombre de una hoja existente en el libro y la variable Rango contenga la dirección de uno o varios rangos de celdas.

Lo ortodoxo sería Sheets(Plantilla).Range(Rango).Value = Empty, aunque en el objeto Range la propiedad .Value se asume por defecto.

Tu error ha sido almacenar en la variable Rango el valor de las celdas y no su dirección.

Así funcionará hasta un máximo de 64 celdas, luego te dará un error 1004.

If Rango = "" Then Rango = Celda.Address Else Rango = Rango & "," & Celda.Address

Por eso yo te recomiendo trabajar con objetos y no con direcciones:

Sub Factura_LimpiarPlantilla()

Dim Rango As Range

Dim Plantilla As Worksheet

Dim Setup As Worksheet


Set Plantilla = Sheets("Factura_Registro")

Set Setup = Sheets("Factura_Setup")


Application.ScreenUpdating = False

Plantilla.Unprotect Clave


I = 2

While Setup.Cells(I, 3) <> ""

  If Setup.Cells(I, 5) = "SI" Then

      If Rango Is Nothing Then

        Set Rango = Setup.Cells(I, 3)

      Else

        Rango = Application.Union(Rango, Setup.Cells(I, 3))

      End If

  End If

  I = I + 1

Wend


If Not Rango Is Nothing Then Rango = Empty

Plantilla.Protect Clave

Application.ScreenUpdating = True


End Sub

[/CODE]

[/color]

[color=#000000]O aunque mas lento, pero mas sencillo:[/color]

[color=rgb(0, 0, 255)]

[CODE]Sub Factura_LimpiarPlantilla()

Dim Plantilla As Worksheet
Dim Setup As Worksheet

Set Plantilla = Sheets("Factura_Registro")
Set Setup = Sheets("Factura_Setup")

Application.ScreenUpdating = False
Plantilla.Unprotect Clave

I = 2
While Setup.Cells(I, 3) <> ""
If Setup.Cells(I, 5) = "SI" Then
Setup.Cells(I, 3) = Empty
I = I + 1
Wend

Plantilla.Protect Clave
Application.ScreenUpdating = True

End Sub
[/CODE]

[/color]

.

PD: [color=#ff0000]Como no has subido el archivo, tal como indican las normas, los códigos no han sido probados.

.[/color]

[/b]

[joanlo]

@[uSER=7340]marco antonio[/uSER]

Gracias por tu respuesta, pero ese no es el problema.

Me explicaré mejor,

En la Hoja Setup en la Columna 3, tengo almacenadas las direcciones de las celdas.

La variable Celda lo que hace es traer esa dirección (ejem A1, B5)

En la Variable Rango voy almacenando todas las direcciones ejem (A1,B5,H9)

El problema Radica que al utilizar Sheets(Plantilla).Range(Rango)=Emtpy el sistema arroja error porque al parecer el rango que quiero borrar es demasiado extenso.

Rango toma el siguiente valor al ejecutar la marco

Rango = N5,U5,B5,G8,G10,K14,G15,G17,G19,G21,G23,G25,P8,C29,E29,O29,Q29,S29,V29,X29,C30,E30,O30,Q30,S30,V30,X30,C31,E31,O31,Q31,S31,V31,X31,C32,E32,O32,Q32,S32,V32,X32,C33,E33,O33,Q33,S33,V33,X33,C34,E34,O34,Q34,X34,S34,V34,C35,E35,O35,Q35,S35,V35,X35,C36,E36,O36,Q36,S36,V36,X36,C37,E37,O37,Q37,S37,V37,X37,C38,E38,O38,Q38,S38,V38,X38,X41,X42,E43,N43,E45,H45,J45,O45,E46,H46,J46,O46,E47,H47,J47,O47,E48,H48,J48,O48

[Antoni]

.

Ya te lo he explicado en el post anterior:

Así funcionará hasta un máximo de 64 celdas, luego te dará un error 1004.

Y también te he dado la solución:

Por eso yo te recomiendo trabajar con objetos y no con direcciones:

Te dejo la macro modificada para tomar las direcciones de las celdas de la columna 3.

Sub Factura_LimpiarPlantilla()

Dim Rango As Range

Dim Plantilla As Worksheet

Dim Setup As Worksheet


Set Plantilla = Sheets("Factura_Registro")

Set Setup = Sheets("Factura_Setup")


Application.ScreenUpdating = False

Plantilla.Unprotect Clave


I = 2

While Setup.Cells(I, 3) <> ""

  If Setup.Cells(I, 5) = "SI" Then

      If Rango Is Nothing Then

        Set Rango = Setup.Range(Setup.Cells(I, 3).Value)

      Else

        Set Rango = Application.Union(Rango, Setup.Range(Setup.Cells(I, 3).Value))

      End If

  End If

  I = I + 1

Wend


If Not Rango Is Nothing Then Rango = Empty

Plantilla.Protect Clave

Application.ScreenUpdating = True

End Sub

[/CODE]

.