lautaroml
05-12-2014, 04:52 PM
Tengo un codigo macro que hace lo siguiente:
Dejo un diagrama de lo que hace en esta foto:
11676
Lo que necesito es que me den una mano para modificar el codigo, para las siguientes dos cosas:
1)Que no solo copie y pegue las celdas B,C y D. Necesito que copie y pegue tambien la celda A y/o otras posibles celdas (siempre dentro de la misma fila)
2)Necesito saber como agregar una cuarta columna de opciones (4șopcion) y que el codigo haga lo mismo que hace ahora con las tres opciones (columna B, C y D) pero ahora con 4 opciones (columnas B, C, D y E)
El codigo es el siguiente.
Cualquier ayuda, se los voy a agradecer mucho!
Gracias!!
Sub blah()
Set DestSheets = Sheets(Array("pageB", "pageC", "pageD"))
Limits = Array("", 1, 2, 2)
DestnRow = Array("", 1, 1, 1)
For Each rw In Sheets("page1").Range("B1:D5").Rows
v = Application.Index(rw.Value, 1, 0)
If v(1) > v(2) Then temp = v(2): v(2) = v(1): v(1) = temp
If v(2) > v(3) Then temp = v(2): v(2) = v(3): v(3) = temp
If v(1) > v(2) Then temp = v(2): v(2) = v(1): v(1) = temp
For i = 1 To 3
x = Application.Match(v(i), rw, 0)
If Limits(x) > 0 Then
rw.Copy DestSheets(x).Cells(DestnRow(x), 1)
DestnRow(x) = DestnRow(x) + 1
Limits(x) = Limits(x) - 1
Exit For
End If
Next i
Next rw
End Sub
Dejo un diagrama de lo que hace en esta foto:
11676
Lo que necesito es que me den una mano para modificar el codigo, para las siguientes dos cosas:
1)Que no solo copie y pegue las celdas B,C y D. Necesito que copie y pegue tambien la celda A y/o otras posibles celdas (siempre dentro de la misma fila)
2)Necesito saber como agregar una cuarta columna de opciones (4șopcion) y que el codigo haga lo mismo que hace ahora con las tres opciones (columna B, C y D) pero ahora con 4 opciones (columnas B, C, D y E)
El codigo es el siguiente.
Cualquier ayuda, se los voy a agradecer mucho!
Gracias!!
Sub blah()
Set DestSheets = Sheets(Array("pageB", "pageC", "pageD"))
Limits = Array("", 1, 2, 2)
DestnRow = Array("", 1, 1, 1)
For Each rw In Sheets("page1").Range("B1:D5").Rows
v = Application.Index(rw.Value, 1, 0)
If v(1) > v(2) Then temp = v(2): v(2) = v(1): v(1) = temp
If v(2) > v(3) Then temp = v(2): v(2) = v(3): v(3) = temp
If v(1) > v(2) Then temp = v(2): v(2) = v(1): v(1) = temp
For i = 1 To 3
x = Application.Match(v(i), rw, 0)
If Limits(x) > 0 Then
rw.Copy DestSheets(x).Cells(DestnRow(x), 1)
DestnRow(x) = DestnRow(x) + 1
Limits(x) = Limits(x) - 1
Exit For
End If
Next i
Next rw
End Sub