nystyli
12-01-2007, 09:59 AM
Hello. If I could get some help to make this kind of code a bit easier.
In Sheet1 I have parameters (200) in column 1 and in Sheet2 I have same parameters with values. I need to get the values of parameters and the number from column A (1,2,3,4,5,6) from Sheet2 and paste them in their right place in Sheet1. The problem is that in Sheet2 the parameters are in groups like this
1 | AA | 23 |Bb |45 | | CC | 23 | yy |56 | ...
2 | Bb | 34 |CC | 34 | | AA | 67 | zz | 78 |...
3 | CC | 34 | AA| 45 | | hh | 76 | Bb | 87 |...
I would like the Sheet1 to look like this after executing macro:
AA | 1 |23 | | | | | | |
Bb | 2 | 34 | | | | | 3 | 87 |
CC | 3 | 34 | 2 | 34 | 1 | 23 | | |
hh | | | | | 3 | 76 | | |
..and so on...
So basicly I need a loop that repeats this kind of code
Sub Button2_Click()
Dim areaT1, areaT2, cellT1, cellT2
Sheets("Sheet2").Activate
areaT2 = "B1:B" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT1 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT1 In Sheets("Sheet1").Range(areaT1)
For Each cellT2 In Sheets("Sheet2").Range(areaT2)
If cellT1.Value = cellT2.Value Then
Cells(cellT1.Row, 3).Value = Sheets("Sheet2").Cells(cellT2.Row, 1).Value
Cells(cellT1.Row, 4).Value = Sheets("Sheet2").Cells(cellT2.Row, 3).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT3, areaT4, cellT3, cellT4
Sheets("Sheet2").Activate
areaT4 = "D1:D" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT3 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT3 In Sheets("Sheet1").Range(areaT3)
For Each cellT4 In Sheets("Sheet2").Range(areaT4)
If cellT3.Value = cellT4.Value Then
Cells(cellT3.Row, 5).Value = Sheets("Sheet2").Cells(cellT4.Row, 1).Value
Cells(cellT3.Row, 6).Value = Sheets("Sheet2").Cells(cellT4.Row, 5).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT5, areaT6, cellT5, cellT6
Sheets("Sheet2").Activate
areaT6 = "G1:G" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT5 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT5 In Sheets("Sheet1").Range(areaT5)
For Each cellT6 In Sheets("Sheet2").Range(areaT6)
If cellT5.Value = cellT6.Value Then
Cells(cellT5.Row, 7).Value = Sheets("Sheet2").Cells(cellT6.Row, 1).Value
Cells(cellT5.Row, 8).Value = Sheets("Sheet2").Cells(cellT6.Row, 8).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT7, areaT8, cellT7, cellT8
Sheets("Sheet2").Activate
areaT8 = "I1:I" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT7 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT7 In Sheets("Sheet1").Range(areaT7)
For Each cellT8 In Sheets("Sheet2").Range(areaT8)
If cellT7.Value = cellT8.Value Then
Cells(cellT7.Row, 9).Value = Sheets("Sheet2").Cells(cellT8.Row, 1).Value
Cells(cellT7.Row, 10).Value = Sheets("Sheet2").Cells(cellT8.Row, 10).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT9, areaT10, cellT9, cellT10
Sheets("Sheet2").Activate
areaT10 = "L1:L" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT9 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT9 In Sheets("Sheet1").Range(areaT9)
For Each cellT10 In Sheets("Sheet2").Range(areaT10)
If cellT9.Value = cellT10.Value Then
Cells(cellT9.Row, 11).Value = Sheets("Sheet2").Cells(cellT10.Row, 1).Value
Cells(cellT9.Row, 12).Value = Sheets("Sheet2").Cells(cellT10.Row, 13).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT11, areaT12, cellT11, cellT12
Sheets("Sheet2").Activate
areaT12 = "N1:N" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT11 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT11 In Sheets("Sheet1").Range(areaT11)
For Each cellT12 In Sheets("Sheet2").Range(areaT12)
If cellT11.Value = cellT12.Value Then
Cells(cellT11.Row, 13).Value = Sheets("Sheet2").Cells(cellT12.Row, 1).Value
Cells(cellT11.Row, 14).Value = Sheets("Sheet2").Cells(cellT12.Row, 15).Value
End If
Next
Next
Application.ScreenUpdating = True
End Sub
In Sheet1 I have parameters (200) in column 1 and in Sheet2 I have same parameters with values. I need to get the values of parameters and the number from column A (1,2,3,4,5,6) from Sheet2 and paste them in their right place in Sheet1. The problem is that in Sheet2 the parameters are in groups like this
1 | AA | 23 |Bb |45 | | CC | 23 | yy |56 | ...
2 | Bb | 34 |CC | 34 | | AA | 67 | zz | 78 |...
3 | CC | 34 | AA| 45 | | hh | 76 | Bb | 87 |...
I would like the Sheet1 to look like this after executing macro:
AA | 1 |23 | | | | | | |
Bb | 2 | 34 | | | | | 3 | 87 |
CC | 3 | 34 | 2 | 34 | 1 | 23 | | |
hh | | | | | 3 | 76 | | |
..and so on...
So basicly I need a loop that repeats this kind of code
Sub Button2_Click()
Dim areaT1, areaT2, cellT1, cellT2
Sheets("Sheet2").Activate
areaT2 = "B1:B" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT1 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT1 In Sheets("Sheet1").Range(areaT1)
For Each cellT2 In Sheets("Sheet2").Range(areaT2)
If cellT1.Value = cellT2.Value Then
Cells(cellT1.Row, 3).Value = Sheets("Sheet2").Cells(cellT2.Row, 1).Value
Cells(cellT1.Row, 4).Value = Sheets("Sheet2").Cells(cellT2.Row, 3).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT3, areaT4, cellT3, cellT4
Sheets("Sheet2").Activate
areaT4 = "D1:D" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT3 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT3 In Sheets("Sheet1").Range(areaT3)
For Each cellT4 In Sheets("Sheet2").Range(areaT4)
If cellT3.Value = cellT4.Value Then
Cells(cellT3.Row, 5).Value = Sheets("Sheet2").Cells(cellT4.Row, 1).Value
Cells(cellT3.Row, 6).Value = Sheets("Sheet2").Cells(cellT4.Row, 5).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT5, areaT6, cellT5, cellT6
Sheets("Sheet2").Activate
areaT6 = "G1:G" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT5 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT5 In Sheets("Sheet1").Range(areaT5)
For Each cellT6 In Sheets("Sheet2").Range(areaT6)
If cellT5.Value = cellT6.Value Then
Cells(cellT5.Row, 7).Value = Sheets("Sheet2").Cells(cellT6.Row, 1).Value
Cells(cellT5.Row, 8).Value = Sheets("Sheet2").Cells(cellT6.Row, 8).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT7, areaT8, cellT7, cellT8
Sheets("Sheet2").Activate
areaT8 = "I1:I" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT7 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT7 In Sheets("Sheet1").Range(areaT7)
For Each cellT8 In Sheets("Sheet2").Range(areaT8)
If cellT7.Value = cellT8.Value Then
Cells(cellT7.Row, 9).Value = Sheets("Sheet2").Cells(cellT8.Row, 1).Value
Cells(cellT7.Row, 10).Value = Sheets("Sheet2").Cells(cellT8.Row, 10).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT9, areaT10, cellT9, cellT10
Sheets("Sheet2").Activate
areaT10 = "L1:L" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT9 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT9 In Sheets("Sheet1").Range(areaT9)
For Each cellT10 In Sheets("Sheet2").Range(areaT10)
If cellT9.Value = cellT10.Value Then
Cells(cellT9.Row, 11).Value = Sheets("Sheet2").Cells(cellT10.Row, 1).Value
Cells(cellT9.Row, 12).Value = Sheets("Sheet2").Cells(cellT10.Row, 13).Value
End If
Next
Next
Application.ScreenUpdating = True
Dim areaT11, areaT12, cellT11, cellT12
Sheets("Sheet2").Activate
areaT12 = "N1:N" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
Sheets("Sheet1").Activate
areaT11 = "A1:A" & CStr(Cells.SpecialCells(xlCellTypeLastCell).Row)
For Each cellT11 In Sheets("Sheet1").Range(areaT11)
For Each cellT12 In Sheets("Sheet2").Range(areaT12)
If cellT11.Value = cellT12.Value Then
Cells(cellT11.Row, 13).Value = Sheets("Sheet2").Cells(cellT12.Row, 1).Value
Cells(cellT11.Row, 14).Value = Sheets("Sheet2").Cells(cellT12.Row, 15).Value
End If
Next
Next
Application.ScreenUpdating = True
End Sub