Como armar un bucle en excel
Tengo que armar en un bucle en una hoja de Excel, hay datos desde la columna A hasta la columna J, los datos varias hasta el último dato numérico de la columna A el cual puede ser variable,
El bucle que debo armar es:
Si A2>0, Cortar el valor celda B2 y pegarlo en la celda K1
Si A4>0, Cortar el valor celda B4 y pegarlo en la celda K3
Si A6>0, Cortar el valor celda B6 y pegarlo en la celda K5
Si A8>0, Cortar el valor celda B8 y pegarlo en la celda K7
Si A10>0, Cortar el valor celda B10 y pegarlo en la celda K9
Si A12>0, Cortar el valor celda B12 y pegarlo en la celda K11
Si A14>0, Cortar el valor celda B14 y pegarlo en la celda K13
Si A16>0, Cortar el valor celda B16 y pegarlo en la celda K15
Si A18>0, Cortar el valor celda B18 y pegarlo en la celda K17
Si A20>0, Cortar el valor celda B20 y pegarlo en la celda K19
Si An..>0, Cortar el valor celda Bn.. Y pegarlo en la celda Kn..
Al finalizar ordene los valores considerando la columna B y elimina las filas en las cuales la columna B no tenga datos.
2 respuestas
H o l a: Haber si entendí.
Quieres revisar las filas pares, si la celda A (fila par) es mayor que 0, tiene que hacer 2 acciones, una, pasar el dato de la celda B (fila par) a la celda K (fila non); y la segunda, borrar la fila par.
Al último quieres ordenar por la columna B. Si es correcto, prueba con la siguiente:
Sub Mover()
'Por.Dante Amor
u = Range("A" & Rows.Count).End(xlUp).Row
If Evaluate("=ISEVEN(" & u & ")") = False Then u = u - 1
For i = u To 2 Step -2
If Cells(i, "A") > 0 Then
Cells(i - 1, "K") = Cells(i, "B")
Rows(i).Delete
End If
Next
With ActiveSheet.Sort
.SortFields.Clear: .SortFields.Add Key:=Range("B1:B" & u + 1)
.SetRange Range("A1:K" & u + 1): .Header = xlGuess: .Apply
End With
End SubSi es lo que necesitas
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
Deberías replantear la estructura de tu hoja, ya que si pegas valores en las casillas K1, K2, K3 etc
Las casillas B1, B2, B3 etc nunca van a tener datos (tienen las casillas pares A2, B2, A4 B4) y al eliminar las líneas se perderán los valores en K1, K2, K3 etc
¿No se podrian pegar los valores en K2, K4, K6 etc?
Gracias Gregori00001
En efecto se eliminarían sola las filas impares que no tendrían valor en la columna B, el valor de K1,K3 etc se mantendría por que se pegaría previamente como valor, la eliminación seria al final con la ayuda de un segundo macro al finalizar el bucle de cortar y pegar.
Si con la información adicional de igual manera no se puede y debo replantear, me puedes ayudar únicamente con la primera parte ( bucle) que sería cortar y pegar solo valores
Si A2>0, Cortar el valor celda B2 y pegarlo en la celda K1
Si A4>0, Cortar el valor celda B4 y pegarlo en la celda K3
Si A6>0, Cortar el valor celda B6 y pegarlo en la celda K5
Si A8>0, Cortar el valor celda B8 y pegarlo en la celda K7
Si A10>0, Cortar el valor celda B10 y pegarlo en la celda K9
Si A12>0, Cortar el valor celda B12 y pegarlo en la celda K11
Si A14>0, Cortar el valor celda B14 y pegarlo en la celda K13
Si A16>0, Cortar el valor celda B16 y pegarlo en la celda K15
Si A18>0, Cortar el valor celda B18 y pegarlo en la celda K17
Si A20>0, Cortar el valor celda B20 y pegarlo en la celda K19
Si An..>0, Cortar el valor celda Bn.. Y pegarlo en la celda Kn.
La eliminación la aria de forma manual luego de finalizar el bucle
de antemano gracias por su tiempo
Allá va, tendrás que modificar tasl vez el nombre de la hoja
Sheets("Hoja1").Range("A2").Select
Do While ActiveCell.Value <> ""
PrevCell = ActiveCell.Address
If ActiveCell.Value > 0 Then
ActiveCell.Offset(0, 1).Cut
ActiveCell.Offset(-1, 10).Select
ActiveSheet.Paste
Range(PrevCell).Select
ActiveCell.Offset(2, 0).Select
Else
ActiveCell.Offset(2, 0).Select
End If
Loop
End sub