Ayuda con edicion de este macro
Publicado por lautaro (8 intervenciones) el 13/05/2014 01:47:44
Tengo un codigo macro que hace lo siguiente:
Dejo un diagrama de lo que hace en esta foto:
http://subefotos.com/ver/?8874fc80e7113a63b5e4a84baddee390o.png
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!!
Dejo un diagrama de lo que hace en esta foto:
http://subefotos.com/ver/?8874fc80e7113a63b5e4a84baddee390o.png
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!!
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
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 3x = 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
Valora esta pregunta
0