lautaroml
05-12-2014, 05:08 PM
I have a code that made
I have the following code that does what I show in the picture:
11678
What I need is you to give me a hand to modify the code for the following two things:
1) Do not just copy and paste the cells B, C and D. I need to copy and paste the cell also A and / or other possible cells (always in the same row)
2) I need to know how to add a fourth option`s column (4th option) and that the code does the same as now do with the three options (column B, C and D) but with 4 options (columns B, C, D and E )
This is the code:
I thank you all for your support!
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
I have the following code that does what I show in the picture:
11678
What I need is you to give me a hand to modify the code for the following two things:
1) Do not just copy and paste the cells B, C and D. I need to copy and paste the cell also A and / or other possible cells (always in the same row)
2) I need to know how to add a fourth option`s column (4th option) and that the code does the same as now do with the three options (column B, C and D) but with 4 options (columns B, C, D and E )
This is the code:
I thank you all for your support!
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