Rimedio subito:
Private Sub copiaLista()
Dim k As Integer, z As Integer
z = 15 '(posizione iniziale della lista dei nomi del mese)
For k = 1 To Range("ListaNomi").Rows.Count
ActiveSheet.Cells(z, 6).FormulaR1C1 = Range("ListaNomi").Cells(k, 1).FormulaR1C1
ActiveSheet.Cells(z, 7).FormulaR1C1 = Range("ListaNomi").Cells(k, 2).FormulaR1C1
z = z + 1
Next k
ActiveWorkbook.Names.Add Name:="ListaNomiMese", RefersTo:="=" & Range(Cells(15, 6), Cells(z - 1, 6)).Address(True, True)
Griglia Range("ListaNomiMese")
ActiveWorkbook.Names.Add Name:="ListaReparti", RefersTo:="=" & Range(Cells(15, 7), Cells(z - 1, 7)).Address(True, True)
Griglia Range("ListaReparti")
Range("ListaReparti").Interior.Color = RGB(100, 255, 200)
ActiveWorkbook.Names.Add Name:="NumeriGiorni", RefersTo:="=" & Range(Cells(15, 8), Cells(z - 1, 8)).Address(True, True)
Griglia Range("NumeriGiorni")
Range("NumeriGiorni").Interior.Color = RGB(200, 255, 255)
ActiveWorkbook.Names.Add Name:="NumeriNotti", RefersTo:="=" & Range(Cells(15, 9), Cells(z - 1, 9)).Address(True, True)
Griglia Range("NumeriNotti")
Range("NumeriNotti").Interior.Color = RGB(200, 100, 255)
With ActiveSheet
With .Cells(Range("ListaNomiMese").Row - 1, 6)
.Interior.ColorIndex = 6
.FormulaR1C1 = "NOME"
.HorizontalAlignment = xlCenter
End With
With .Cells(Range("ListaNomiMese").Row - 1, 7)
.Interior.ColorIndex = 8
.FormulaR1C1 = "REPARTO"
End With
With .Cells(Range("ListaNomiMese").Row - 1, 8)
.Interior.ColorIndex = 8
.FormulaR1C1 = "GIORNO"
End With
With .Cells(Range("ListaNomiMese").Row - 1, 9)
.Interior.ColorIndex = 5
.Font.ColorIndex = 2
.FormulaR1C1 = "NOTTE"
End With
.Columns(6).ColumnWidth = 26
Exit Sub
With .Columns(7)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
With .Columns(8)
.ColumnWidth = 6
.HorizontalAlignment = xlCenter
.Font.Bold = True
End With
End With
End Sub
Nessun commento:
Posta un commento