Excel - Ayuda con edicion de este macro

   
Vista:

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!!

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 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
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder