grazie
- Codice: Seleziona tutto
Sub Colore_K()
Application.ScreenUpdating = False
Sheets("K").Select
'1K0 1
For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AG" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 1
For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AH" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 1
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AI" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'4K0 1
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AJ" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 1
For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 3 Then
Range("AK" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'1K0 2
For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AM" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 2
For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AN" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 2
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AO" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'4K0 2
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AP" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 2
For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 4 Then
Range("AQ" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'1K0 3
For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AS" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 3
For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AT" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 3
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AU" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'4K0 3
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AV" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 3
For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 5 Then
Range("AW" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'1K0 4
For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 6 Then
Range("AY" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 4
For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 6 Then
Range("AZ" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 4
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 6 Then
Range("BA" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'4K0 4
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 6 Then
Range("BB" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 4
For i = 9 To 608
For Each cell In Range("X" & i & ":AB" & i)
If cell.Interior.ColorIndex = 6 Then
Range("BC" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'1K0 5
For i = 9 To 608
For Each cell In Range("D" & i & ":H" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BE" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'2K0 5
For i = 9 To 608
For Each cell In Range("I" & i & ":M" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BF" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'3K0 5
For i = 9 To 608
For Each cell In Range("N" & i & ":R" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BG" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'4K0 5
For i = 9 To 608
For Each cell In Range("S" & i & ":W" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BH" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
'5K0 5
For i = 9 To 608
For Each cell In Range("X" & i & ":BA" & i)
If cell.Interior.ColorIndex = 7 Then
Range("BI" & i) = Range("AF" & i)
Exit For
End If
Next cell
Next i
Application.ScreenUpdating = True
End Sub