Bucle next i para varios rangos
Estoy pensando en una macro para hacer algo con varios de un libro. Mi idea era definirlos al principio de la macro así:
Set Rango1 = Range("rangopdf1")
Set Rango2 = Range("rangopdf2")
Set Rango3 = Range("rangopdf3")
Set Rango4 = Range("rangopdf4")
'etcPara luego hacer
for i = 1 to i = 20 rangoi.select 'el resto de la macro
Pero por lo visto no funciona jaja.
¿Alguna idea de como puedo hacerlo en forma de bucle? Porque sino tendría que escribir el código varias veces para cada rango.
1 respuesta
Prueba lo siguiente:
Sub Bucle_Rangos() Dim sName As String, i As Long, r As Range sName = "rangopdf" 'Nombre del rango sin el número For i = 1 To 6 'cambia 6 por el número máximo de rangos Set r = Range(sName & i) r.Select ' 'el resto de la macro ' Next End Sub
Si tienes problemas con "el resto de la macro", pon aquí tu código y una breve explicación de lo que necesitas hacer.
Gracias Dante, pero te hago una pregunta lo de "rangopdf1" lo use para el ejemplo, en realidad son varios rangos con nombres distintos. ¿se podrá tener esto en cuenta? Sino le cambio los nombres a los rangos de excel y listo.
De hecho hasta algunos de los rangos son variables con ".end(xldown)" por eso quería definirlos antes.
Explica cuál es el objetivo final de lo que quieres.
Pon ejemplos.
El objetivo: aprender a escribir varias lineas menos con el bules for i = next
Son varias macros que tengo que podría reducir muchísimas líneas de código, pero en la que estaba pensando, aun no la tengo armada, era para convertir varios rangos en pdf:
Sub GuardarRangoPDF()
Dim fecha As String
fecha = (Day(Date) & "-" & Month(Date) & "-" & Year(Date))
Set Rango1 = Range("Losasmacizas")
Set Rango2 = Range("Doblado_losasmacizas")
Set Rango3 = Range("Computo_losasmacizas")
Set Rango4 = Range("Renglones_Doblado")
Set Rango5 = Range("A10", Range("AH" & Rows.Count).End(xlUp)).Select
For i = 1 To 5
'RANGOi.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\" & "nombre del rango " & fecha & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
End SubEstoy todavía armando el excel, pero me faltarían unos 5 o 6 rangos mas
Por ejemplo, acabo de adaptar una macro vieja:
Sub Borrar_TODO_vieja()
Resp = MsgBox("Esta accion BORRARA TODOS LOS DATOS cargados ¿desea continuar?", vbQuestion + vbYesNo, "EXCELeINFO")
If Resp = vbYes Then
Application.ScreenUpdating = False
Range("cd_reco1").ClearContents
Range("cd_reco2").ClearContents
Range("cd_reco3").ClearContents
Range("cd_reco4").ClearContents
Range("cd_reco5").ClearContents
Range("cd_reco6").ClearContents
Range("cd_reco7").ClearContents
Range("cd_reco8").ClearContents
Range("cd_reco9").ClearContents
Range("cd_reco10").ClearContents
Range("cd_reco11").ClearContents
Range("cd_reco12").ClearContents
Range("cd_reco13").ClearContents
Range("cd_reco14").ClearContents
Range("cd_reco15").ClearContents
Range("cd_reco16").ClearContents
With Range("inicio1")
.Value = 1
.AutoFill Destination:=Range("nume1"), Type:=xlFillSeries
End With
With Range("inicio2")
.Value = 1
.AutoFill Destination:=Range("nume2"), Type:=xlFillSeries
End With
With Range("inicio3")
.Value = 1
.AutoFill Destination:=Range("nume3"), Type:=xlFillSeries
End With
With Range("inicio4")
.Value = 1
.AutoFill Destination:=Range("nume4"), Type:=xlFillSeries
End With
With Range("inicio5")
.Value = 1
.AutoFill Destination:=Range("nume5"), Type:=xlFillSeries
End With
With Range("inicio6")
.Value = 1
.AutoFill Destination:=Range("nume6"), Type:=xlFillSeries
End With
With Range("inicio7")
.Value = 1
.AutoFill Destination:=Range("nume7"), Type:=xlFillSeries
End With
With Range("inicio8")
.Value = 1
.AutoFill Destination:=Range("nume8"), Type:=xlFillSeries
End With
With Range("inicio9")
.Value = 1
.AutoFill Destination:=Range("nume9"), Type:=xlFillSeries
End With
With Range("inicio10")
.Value = 1
.AutoFill Destination:=Range("nume10"), Type:=xlFillSeries
End With
With Range("inicio11")
.Value = 1
.AutoFill Destination:=Range("nume11"), Type:=xlFillSeries
End With
With Range("inicio12")
.Value = 1
.AutoFill Destination:=Range("nume12"), Type:=xlFillSeries
End With
With Range("inicio13")
.Value = 1
.AutoFill Destination:=Range("nume13"), Type:=xlFillSeries
End With
With Range("inicio14")
.Value = 1
.AutoFill Destination:=Range("nume14"), Type:=xlFillSeries
End With
With Range("inicio15")
.Value = 1
.AutoFill Destination:=Range("nume15"), Type:=xlFillSeries
End With
With Range("inicio16")
.Value = 1
.AutoFill Destination:=Range("nume16"), Type:=xlFillSeries
End With
End If
Application.ScreenUpdating = True
End SubAprovechando lo que me pasaste:
Sub Borrar_TODO()
Resp = MsgBox("Esta accion BORRARA TODOS LOS DATOS cargados ¿desea continuar?", vbQuestion + vbYesNo, "EXCELeINFO")
If Resp = vbYes Then
Application.ScreenUpdating = False
Dim sName1 As String, sName2 As String, sName3 As String, i As Long, rng1 As Range, rng2 As Range, rng3 As Range
sName1 = "cd_reco"
sName2 = "inicio"
sName3 = "nume"
For i = 1 To 16
Set rng1 = Range(sName1 & i)
Set rng2 = Range(sName2 & i)
Set rng3 = Range(sName3 & i)
rng1.ClearContents
rng2.Value = 1
rng2.AutoFill Destination:=rng3, Type:=xlFillSeries
Next
Application.ScreenUpdating = True
End If
End Sub
Por ejemplo:
Sub GuardarRangoPDF()
Dim fecha As String, rngs As Variant, i As Long, sName As String
'
fecha = (Day(Date) & "-" & Month(Date) & "-" & Year(Date))
rngs = Array("Losasmacizas", "Doblado_losasmacizas", "Computo_losasmacizas", _
"Renglones_Doblado", Range("A10", Range("AH" & Rows.Count).End(xlUp)).Address)
'
For i = 0 To UBound(rngs)
sName = ThisWorkbook.Path & "\" & Replace(rngs(i), ":", "_") & " " & fecha & ".pdf"
Range(rngs(i)).ExportAsFixedFormat xlTypePDF, sName, xlQualityStandard, True, False, , , False
Next i
End Sub
