studiavo e riflettevo sulla tua soluzione al mio thread precedente (http://www.pc-facile.com/forum/viewtopic.php?f=26&t=107327)
E mi chiedevo se detta modalità (keeplist) fosse applicabile anche alla seguente macro (presente nel file postato in precedenza):
- Codice: Seleziona tutto
Private Sub Label21_Click() 'Caption= SALVA 1) Inserisce i dati nel Foglio "Anagrafica"; 2) Inserisce i dati nel Foglio "3_SqEmergenza" spuntando con X i vari addetti;
'3) Svuota i campi della UserForm; 4) Inserisce i bordi nel Foglio "0_Nuovo assunto" e nel Foglio "3_SqEmergenza"
Dim wks As Worksheet, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Dim wks4 As Worksheet, wks5 As Worksheet, wks6 As Worksheet, wks7 As Worksheet
Dim uriga1 As Long, uriga2 As Long, uRiga3 As Long, uRiga4 As Long, uRiga5 As Long, uRiga6 As Long, y As Integer
Set wks = Sheets("Anagrafica")
Set wks1 = Sheets("0_Nuovo assunto")
Set wks2 = Sheets("3_SqEmergenza")
Set wks3 = Sheets("1_Formazione Sicurezza")
Set wks4 = Sheets("2_Aggiornamenti")
Set wks5 = Sheets("4_Addestramento Specifico")
Set wks6 = Sheets("1_Formaz Somm")
Set wks7 = Sheets("Anagrafica (2)")
uriga = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
uRiga6 = wks6.Range("A" & Rows.Count).End(xlUp).Row + 1
uRiga7 = wks7.Range("A" & Rows.Count).End(xlUp).Row + 1
''INSERIMENTO DATI
If ComboBox6 <> "SOMMINISTRATO" Then 'SE E' DIVERSO DA SOMMINISTRATO
With wks 'Foglio: Anagrafica
.Cells(3, 1) = 1
.Cells(uriga, 1) = uriga - 2
.Cells(uriga, 2) = TextBox15 'data inizio
.Cells(uriga, 3) = TextBox1 & " " & TextBox2 ' cognome + nome
.Cells(uriga, 4) = TextBox1 'cognome
.Cells(uriga, 5) = TextBox2 'nome
.Cells(uriga, 6) = OptionButton1 'nuovo assunto
.Cells(uriga, 7) = TextBox12 'data nascita
.Cells(uriga, 8) = TextBox13 'luogo nascita
.Cells(uriga, 9) = TextBox14 'codice fiscale
.Cells(uriga, 10) = ComboBox7 'qualifica
.Cells(uriga, 11) = ComboBox1 'stabilimento
.Cells(uriga, 12) = ComboBox3 'ruolo aziendale
.Cells(uriga, 13) = ComboBox4 'ruolo sicurezza
.Cells(uriga, 14) = ComboBox5 'titolo di studio
.Cells(uriga, 15) = ComboBox6 'in forza
End With
With wks1 'Foglio: 0_Nuovo assunto
uriga1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & uriga1).Value = TextBox1 & " " & TextBox2
.Range("M" & uriga1).Value = Format(TextBox15, "mm/dd/yyyy")
.Range("N" & uriga1).Value = CDate(TextBox15) + 60 ' ossia TexBox15+60gg
.Range("O" & uriga1) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
End With
Else ' DIVERSAMENTE (SE E' SOMMINISTRATO)
With wks7 'Foglio: Anagrafica (2)
.Cells(3, 1) = 1
.Cells(uRiga7, 1) = uRiga7 - 2
.Cells(uRiga7, 2) = TextBox15 'data inizio
.Cells(uRiga7, 3) = TextBox1 & " " & TextBox2 ' cognome + nome
.Cells(uRiga7, 4) = TextBox1 'cognome
.Cells(uRiga7, 5) = TextBox2 'nome
.Cells(uRiga7, 6) = OptionButton1 'nuovo assunto
.Cells(uRiga7, 7) = TextBox12 'data nascita
.Cells(uRiga7, 8) = TextBox13 'luogo nascita
.Cells(uRiga7, 9) = TextBox14 'codice fiscale
.Cells(uRiga7, 10) = ComboBox7 'qualifica
.Cells(uRiga7, 11) = ComboBox1 'stabilimento
.Cells(uRiga7, 12) = ComboBox3 'ruolo aziendale
.Cells(uRiga7, 13) = ComboBox4 'ruolo sicurezza
.Cells(uRiga7, 14) = ComboBox5 'titolo di studio
.Cells(uRiga7, 15) = ComboBox6 'in forza
End With
With wks6 'Foglio: 1_Formaz Somm
.Range("A" & uRiga6).Value = TextBox1 & " " & TextBox2
.Range("B" & uRiga6).Value = Format(TextBox15, "mm/dd/yyyy")
.Range("C" & uRiga6).Value = CDate(TextBox15) + 60 ' ossia TexBox15+60gg
.Range("U" & uRiga6) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
End With
End If
With wks2 'Foglio: 3_SqEmergenza
uriga2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
If ComboBox4 = "RLS" Then
.Cells(uriga2, 1) = TextBox1 & " " & TextBox2
.Cells(uriga2, 2) = "X"
ElseIf ComboBox4 = "Addetto alle Emergenze" Then
.Cells(uriga2, 1) = TextBox1 & " " & TextBox2
.Cells(uriga2, 3) = "X"
ElseIf ComboBox4 = "Addetto Antincendio" Then
.Cells(uriga2, 1) = TextBox1 & " " & TextBox2
.Cells(uriga2, 4) = "X"
ElseIf ComboBox4 = "Addetto I Soccorso" Then
.Cells(uriga2, 1) = TextBox1 & " " & TextBox2
.Cells(uriga2, 5) = "X"
End If
End With
'____________ CODICE INSERISCI BORDI
With wks1 'Foglio: 0_Nuovo assunto
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 7 To uRow 'ciclo che spazzola dalla riga 7 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A7:O" & y).Borders 'stabilisce l'intervallo che va dalla cella A7 alla Cella O (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 2 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
With wks2
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 5 To uRow 'ciclo che spazzola dalla riga 5 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A5:AA" & y).Borders 'stabilisce l'intervallo che va dalla cella A5 alla Cella AA (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 1 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
'____________ CODICE ORDINE ALFABETICO
uRow = wks2.Cells(Rows.Count, 1).End(xlUp).Row
With wks2.Range("A5:AA" & uRow) 'Foglio: 3_SqEmergenza
.Sort Key1:=wks2.Range("A5"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1
End With
'wks3 ______1_FormazioneSicurezza_importa dati
With wks3
uRiga3 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & uRiga3).Value = TextBox1 & " " & TextBox2
.Range("B" & uRiga3).Value = CDate(TextBox15) + 60 ' ossia TexBox15+60gg
For y = 1 To 28 'oppure basta 1 To 2 ?
TextBoxy = ""
ComboBoxy = ""
Next
End With
'____ed inserisce i bordi
With wks3 'Foglio: 1_Formazione Sicurezza
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 7 To uRow 'ciclo che spazzola dalla riga 7 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A7:AB" & y).Borders 'stabilisce l'intervallo che va dalla cella A7 alla Cella AB (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 2 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
'wks3 ______1_FormazioneSicurezza_FINE
'wks4 ______2_Aggiornamenti_importa dati
With wks4 'Foglio: 2_Aggiornamenti
uRiga4 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & uRiga4).Value = TextBox1 & " " & TextBox2
For y = 1 To 28
TextBoxy = ""
ComboBoxy = ""
Next
End With
'____ed inserisce i bordi
With wks4 'Foglio: 2_Aggiornamenti
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 5 To uRow 'ciclo che spazzola dalla riga 5 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A5:AB" & y).Borders 'stabilisce l'intervallo che va dalla cella A5 alla Cella AB (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 2 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
'wks4 ______2_Aggiornamenti__FINE
'wks5 ______4_Addestramento Specifico_importa dati
With wks5 'Foglio: 4_Addestramento Specifico
uRiga5 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & uRiga5).Value = TextBox1 & " " & TextBox2
End With
'____ed inserisce i bordi
With wks5 ' Foglio: 4_Addestramento Specifico
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 7 To uRow 'ciclo che spazzola dalla riga 7 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A7:Z" & y).Borders 'stabilisce l'intervallo che va dalla cella A7 alla Cella Z (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 2 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
With wks6 ' Foglio: 1_Formaz Somm
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 7 To uRow 'ciclo che spazzola dalla riga 7 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A7:U" & y).Borders 'stabilisce l'intervallo che va dalla cella A7 alla Cella U (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 2 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
With wks7 ' Foglio: Anagrafica (2)
uRow = .Cells(Rows.Count, 1).End(xlUp).Row 'trova l'ultima cella piena nella colonna A
For y = 3 To uRow 'ciclo che spazzola dalla riga 3 all'ultima piena
If .Cells(y, 1) <> "" Then 'se le celle della colonna A sono piene
With .Range("A3:O" & y).Borders 'stabilisce l'intervallo che va dalla cella A3 alla Cella O (numero di riga ultima cella piena)
.LineStyle = xlContinuous 'questa riga prevede l'esistenza del bordo
.ColorIndex = 12 'questa riga stabilisce il colore del bordo
.Weight = 2 'questa riga stabilisce lo spessore del bordo (1 il pi piccolo)
End With
End If
Next
End With
For y = 1 To 21
TextBoxy = ""
ComboBoxy = ""
Next y
MsgBox "Dato inserito correttamente!"
Set wks = Nothing
Set wks1 = Nothing
Set wks2 = Nothing
Set wks3 = Nothing
Set wks4 = Nothing
Set wks5 = Nothing
Set wks6 = Nothing
Set wks7 = Nothing
End Sub
Grazie in anticipo della tua risposta.