FOGLIO PRESTITO BIBLIOTECA SCOLASTICA, AIUTO PER CREARE IL COMANDO: SE COMPILI UNA CASELLA, COMPIA L'INTERA RIGA ED INCOLLALA IN AUTOMATICO NEL SECONDO FOGLIO.

ciao

(temo che qualche maestra di dimentichi di schiacciare...)

non è che hai fiducia eh!😀

potevamo farlo fare in automatico mettendola al CHANGE

ma le macro sono irreversibili (se non fai un'altra macro non si torna indietro)

perchè ho messo il pulsante?

1. puoi controllare prima di attivare la macro
2. se uno si dimentica non è un dramma lo fa quello dopo
3. è a prova di inesperto

Un dubbio mi viene

se hai personale inesperto in chiusura file

si ricordano di salvare o qualcuno potrebbe anche chiudere senza salvataggio?

non è il caso di mettere una macro in chiusura che attivi

lo spostamento delle righe e che salvi in automatico?

Ciao Alessandra,

In realtà il fatto che potesse eseguire il comando senza bisogno di dover schiacciare il pulsante, sarebbe stata una cosa moooolto gradita (temo che qualche maestra di dimentichi di schiacciare...) però non sono riuscita a usare il tuo codice perchè sono inesperta...

Sospetto che le tue difficoltà siano principalmente legate a fattori di cui non ho tenuto conto fino a quando non ho scaricato il tuo file. Ora ho adattato il mio codice in base a questo file.

In primo luogo, farei il premesso di aver rimosso tutte le celle unite dal foglio Biblio BES 22 23. L'ho fatto perché, nella mia esperienza, causano molti problemi con l'esecuzione del codice VBA. Personalmente evito sempre l'uso di celle unite e, laddove altrimenti si potrebbe essere tentati di adottarle, preferisco utilizzare l'impostazione di allineamento del formato allinea al centro nelle colonne

Se questo è accettabile per te,prova quanto segue:

• Nel tuo file, inserisci un nuovo foglio (in mio caso Foglio3)
• Nella cella A1 di questo foglio, immetti la formula

          =SUBTOTALE(3;'Biblio BES 22 23'!J:J)
  

• Fai clic dx sulla linguetta del nuovo foglio
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Calculate()

Dim srcSH  As Worksheet, destSH As Worksheet 

Dim Rng As Range, srcRng As Range, destrng As Range 

Dim sFilter As String 

Dim LRow As Long 

Const sFoglio\_Destinazione As String = **"PRESTITI"                      '<<=== Modifica**

With ThisWorkbook 

    Set srcSH = .Sheets(sFoglio\_Sorgente) 

End With 

Set Rng = srcSH.Range("J3") 

sFilter = FilterCriteria(Rng) 

If sFilter = "=Sì" Then 

    ThisWorkbook.Names("myFilter").RefersTo = sFilter 

    With srcSH 

        .Outline.ShowLevels RowLevels:=0, ColumnLevels:=2 

        Set srcRng = .AutoFilter.Range.Offset(1) 

    End With 

    With srcRng 

        On Error Resume Next 

        Set srcRng = .Offset(1).Resize(.Rows.Count - 2).SpecialCells(xlCellTypeVisible) 

    End With 

    On Error GoTo 0 

    If Not srcRng Is Nothing Then 

        Set destSH = ThisWorkbook.Sheets(sFoglio\_Destinazione) 

        With destSH 

            LRow = LastRow(destSH, .Columns(1)) 

            Set destrng = destSH.Range("A" & LRow + 1) 

        End With 

        On Error GoTo XIT 

        Application.EnableEvents = False 

        With srcRng.EntireRow 

            .Copy Destination:=destrng 

            .Delete 

        End With 

    End If 

    srcSH.AutoFilter.Range.AutoFilter Field:=10 

End If 

XIT:

ThisWorkbook.Names("myFilter").RefersTo = sFilter 

Application.EnableEvents = True 

End Sub

'<<========'

• Ctrl+R per accedere alla finestra Project Explorer ('Gestione progetti')
• Fai doppio clic sul modulo ThisWorkbook (Questa_cartella_di_Lavoro) del file e incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Workbook_Open()

Dim SH  As Worksheet 

Dim Rng As Range 

Dim oName As Name 

Dim sFilter As String 

Set SH = Me.Sheets(sFoglio\_Sorgente) 

Set Rng = SH.Range("J3") 

sFilter = FilterCriteria(Rng) 

On Error Resume Next 

Set oName = Me.Names(sName) 

On Error GoTo 0 

Me.Names.Add Name:=sName, RefersTo:=sFilter 

End Sub

'<<========

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'========>>

Option Explicit

Public Const sName As String = "myFilter"

Public Const sFoglio_Sorgente As String = "Biblio BES 22 23" '<<=== Modifica

'-------->>

Public Function FilterCriteria(Rng As Range) As String

'#######################################################################

'\\  By Stephen Bullen 

'\ The single-cell argument for the FilterCriteria function

'\\  can refer to any cell within the column of interest. 

'\\  The formula will return the current AutoFilter criteria 

'\\  (if any) for the specified column. When you turn AutoFiltering 

'\\  off, the formulas don't display anything. 

'########################################################################

Dim Filter As String 

Filter = "-" 

On Error GoTo Finish 

With Rng.Parent.AutoFilter 

    If Intersect(Rng, .Range) Is Nothing Then GoTo Finish 

    With .Filters(Rng.Column - .Range.Column + 1) 

        If Not .On Then GoTo Finish 

        Filter = .Criteria1 

        Select Case .Operator 

            Case xlAnd 

                Filter = Filter & " AND " & .Criteria2 

            Case xlOr 

                Filter = Filter & " OR " & .Criteria2 

        End Select 

    End With 

End With 

Finish:

FilterCriteria = Filter 

End Function

'--------->>

Public Function LastRow(SH As Worksheet, _

Optional Rng As Range, \_ 

Optional minRow As Long = 1) 

If Rng Is Nothing Then 

    Set Rng = SH.Cells 

End If 

On Error Resume Next 

LastRow = Rng.Find(What:="\*", \_ 

    After:=Rng.Cells(1), \_ 

    Lookat:=xlPart, \_ 

    LookIn:=xlFormulas, \_ 

    SearchOrder:=xlByRows, \_ 

    SearchDirection:=xlPrevious, \_ 

    MatchCase:=False).Row 

On Error GoTo 0 

If LastRow < minRow Then 

    LastRow = minRow 

End If 

End Function

'<<========

• Alt+Q per chiudere l'editor di VBA e tornare a Excel.
• Se lo desideri, puoi anche nascondere il nuovo foglio (Foglio3)
• Salva il file con l'estensione xlsm
• Chiudi e riapri il file

In questo modo, ogni volta che i dati sul foglio Biblio BES 22 23 vengono filtrati utilizzando la voce Sì per la colonna RESTITUITO?, i dati filtrati verranno copiati sul foglio PRESTITI e tali dati verranno cancellati dal foglio sorgente. Inoltre, il criterio di filtro verrà annullato in modo da visualizzare tutti i dati rimanenti sul foglio di origine.

Potresti caricare il mio file di prova Alessandra20221018.xlsm

Si noti che in questo file ho creato un intervallo denominato (Criteri) che si riferisce all'intervallo C1:C2 sul nuovo foglio e l'ho usato come fonte di convalida dei dati per la colonna RESTITUITO sul foglio Biblio BES 22 23.

===

Regards,

Norman

In realtà il fatto che potesse eseguire il comando senza bisogno di dover schiacciare il pulsante, sarebbe stata una cosa moooolto gradita (temo che qualche maestra di dimentichi di schiacciare...) però non sono riuscita a usare il tuo codice perchè sono inesperta...

[..]

ma

quelle di Norman sono più evolute

Forse, ma il mio codice è stato progettato per rispondere automaticamente a un'azione di filtro, leggere il criterio di filtro corrente e reagire di conseguenza.

Se, come hai suggerito, l'operazione di trasferimento può essere eseguita in risposta alla pressione di un pulsante, il mio codice è inutilmente complesso e prolisso.

Per questo motivo, ho scelto di non pubblicare il mio codice aggiornato e mi sono permesso di contrassegnare la tua risposta come soluzione preferita.

===

Regards,

Norman