Ma faccio un breve riassunto:
Ho un file chiamato protocollo.xlsm che utilizzo per protocollare le pratiche dell'ufficio.
Il file è composto da 4 fogli (SCHEDA, REGISTRO, CHIUSE, SCHEDATECNICA).
Nel foglio chiuse, vengono spostate tutte le pratiche una volta che queste sono chiuse e nella colonna J viene indicata la data dello spostamento/chiusura.
Ora per non appesantire troppo l'apertura del file, ma mantenendo comunque tutta la cronologia ho pensato di spostare le righe che riportano la data più vecchia di 3 mesi in un altro file che ho chiamato pratiche-chiuse.xlsm
Per cercare di fare questo ho aggiunto un modulo con il seguente codice:
- Codice: Seleziona tutto
Sub MoveRows()
Dim mydate As Date
mydate = DateAdd("mm", -3, Date) 'Get the date 3 years ago from today
Dim lastrow As Long
lastrow = Sheets("CHIUSE").Cells(Rows.Count, "J").End(xlUp).Row 'Find the last row with data in column J of Sheet3
Dim i As Long
For i = lastrow To 1 Step -1 'Loop through rows from bottom to top
If Sheets("CHIUSE").Cells(i, "J").Value < mydate Then 'If the date in column J is older than 3 years
Sheets("CHIUSE").Rows(i).Cut 'Cut the row
Workbooks("pratiche-chiuse").Sheets("Sheet1").Rows(Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row + 1).Insert Shift:=xlDown 'Insert the row into Sheet1
End If
Next i
End Sub
Che faccio richiamare nel Worksheet_Change "foglio CHIUSE" con un Call
Di seguito per completezza riporto il codice del foglio chiuse:
- Codice: Seleziona tutto
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ur As Long
If Target.Count > 1 Then Exit Sub
'
If Target.Column = 9 Then '9=I
ur = Sheets("REGISTRO").Cells(Rows.Count, 1).End(xlUp).Row
Target.Offset(0, 1).Value = Now ' ADD Aggiunge Data di cambio status in J
Target.Offset(0, 1).NumberFormat = "dd/mm/yyyy" ' ADD formato
If Right(Target.Value, 6) = "APERTA" Then
Application.EnableEvents = False
Range("A" & Target.Row & ":" & "J" & Target.Row).Copy Destination:=Sheets("REGISTRO").Cells(ur + 1, 1) 'MOD
Target.EntireRow.Delete
Application.EnableEvents = True
End If
End If
Call MoveRows
ActiveCell.EntireRow.AutoFit
End Sub
Purtroppo quando faccio il test inserendo una riga con una data più vecchia Ricevo Errore di run-time: 5 su questa riga
- Codice: Seleziona tutto
mydate = DateAdd("mm", -3, Date) 'Get the date 3 years ago from today
che avevo provato a modificare perchè la macro, (trovata online) originariamente faceva un controllo sui 3 anni.
Altro problema che rilevo aggiungendo questo codice è che se in foglio CHIUSE, cambio la dicitura da "CHIUSA" in "APERTA" la riga non ritorna nel foglio REGISTRO, come avveniva prima che aggiungessi il codice.
