MACRO,tengo que repetir 40 veces una condición no se como reducirlo, con aplicacion for o la q me pueda reducir el código
Este mismo paso lo repito 40 veces, lo unico que cambia es que el Rango(rojo) aumenta en la fila de 2 en 2 osea B9, B11, B13... Etc, el valor de la fila(azul) aumenta de 2 en 2 tambien, y le pongo una variable acum, acuma, acumb... Etc para que cuente desde 0, esto me demora demasiado, gracias por sus aportes. EL codigo esta mas abajo para que me puedan guiar, solo en esto es mi problema.
'3072
For j = 1 To 2
For i = 1 To x
If i >= Range("B9") Then
Cells(10, acum + 8) = Sheets("PM").Cells(i + 2, 19)
'Cells(7, acum + 7) = Sheets("PM").Cells(i + 2, 18)
acum = acum + 1
End If
Next i
For i = 1 To x
If i < Range("B9") Then
Cells(10, acum + 8) = Sheets("PM").Cells(i + 2, 19)
'Cells(7, acum + 7) = Sheets("PM").Cells(i + 2, 18)
acum = acum + 1
End If
Next i
Next j
'3073
For j = 1 To 2
For i = 1 To x
If i >= Range("B11") Then
Cells(12, acuma + 8) = Sheets("PM").Cells(i + 2, 19)
acuma = acuma + 1
End If
Next i
For i = 1 To x
If i < Range("B11") Then
Cells(12, acuma + 8) = Sheets("PM").Cells(i + 2, 19)
acuma = acuma + 1
End If
Next i
Next j
'3050
1 Respuesta
H o l a : Para entender el código y modificarlo o crear uno nuevo, tendrías que explicarme qué quieres hacer.
Envíame tu archivo con varios ejemplos y me explicas qué quieres pasar de cuál hoja a cuál hoja.
Si es posible pon una hoja antes de la ejecución y en otra hoja pones los datos después de la ejecución, de esa forma podría visualizar qué estás pasando de una hoja a otra. Explícame cada ejemplo con comentarios, colores, imágenes.
Mi correo [email protected]
En el asunto del correo escribe tu nombre de usuario “Enrique SC” y el título de esta pregunta.
Te envie un mensaje, con la informacion del correo [email protected], muchas gracias...
Te anexo la macro
Sub posicion1()
'Por.Dante Amor
Application.ScreenUpdating = False
Set h1 = Sheets("PM")
Set h2 = Sheets("Programacion PM")
f = 3
Do While h1.Cells(f, "R") <> ""
f = f + 1
Loop
fin = f - 1
'
ini = 3
For i = 9 To h2.Range("B" & Rows.Count).End(xlUp).Row Step 2
lin = h2.Cells(i, "B")
If lin = 1 Then
h1.Range(h1.Cells(ini, "S"), h1.Cells(fin, "S")).Copy
h2.Cells(i + 1, "H").PasteSpecial Paste:=xlPasteValues, Transpose:=True
h2.Cells(i + 1, "P").PasteSpecial Paste:=xlPasteValues, Transpose:=True
Else
ini_1 = 3
fin_1 = ini + lin - 2
ini_2 = ini + lin - 1
fin_2 = fin
co_1 = Columns("H").Column + 8 - lin + 1
co_2 = Columns("P").Column + 8 - lin + 1
'
h1.Range(h1.Cells(ini_2, "S"), h1.Cells(fin_2, "S")).Copy
h2.Cells(i + 1, "H").PasteSpecial Paste:=xlPasteValues, Transpose:=True
h2.Cells(i + 1, "P").PasteSpecial Paste:=xlPasteValues, Transpose:=True
h1.Range(h1.Cells(ini_1, "S"), h1.Cells(fin_1, "S")).Copy
h2.Cells(i + 1, co_1).PasteSpecial Paste:=xlPasteValues, Transpose:=True
h2.Cells(i + 1, co_2).PasteSpecial Paste:=xlPasteValues, Transpose:=True
End If
Next
Application.ScreenUpdating = True
MsgBox "fin"
End Subsal u dos
MUCHAS GRACIAS¡¡¡¡¡ solo 2 dudas inge, cuando modifico el rango en la hoja "Programacion" como en la imagen, donde tendría que modificar en el código.
y cuando aumento el rango en posicion donde tendría que modificar:
Saludos.
d
Mmm, eso no es tan simple, por eso te pregunté: "siempre son 8 posiciones" y tu respuesta fue "Sí".
Tendría que revisarlo y crear otra macro.
