Excel VBA: spostare automaticamente una riga in base al valore del menu a discesa

Vuoi spostare automaticamente un’intera riga di Excel in base al valore scelto in un elenco a discesa? Con una piccola macro VBA “evento‑driven” puoi farlo in modo affidabile: l’utente seleziona lo Status, la riga (A‑M) va nel foglio omonimo e scompare da “Register”. Di seguito trovi soluzione base, variante pro, personalizzazioni, log e troubleshooting.

Scenario e obiettivi

Hai un foglio di lavoro chiamato Register con una colonna Status (elenco a discesa). I valori della lista coincidono con i nomi di fogli esistenti: Zone1, Zone2, … Obiettivo:

• quando lo Status cambia, copiare l’intera riga (colonne A‑M) nel foglio con lo stesso nome;
• eliminare la riga originale da Register;
• se lo Status viene cambiato di nuovo (anche su un altro foglio), spostare la riga nel nuovo foglio di destinazione.

Il tutto senza interventi manuali, con una macro semplice da distribuire anche a chi non programma.

Come funziona a livello logico

La soluzione sfrutta gli eventi di Excel:

• Worksheet_Change: reagisce alle modifiche della cella nello specifico foglio (versione base, solo su Register);
• Workbook_SheetChange: intercetta le modifiche su qualsiasi foglio della cartella (versione pro, consigliata se vuoi che il movimento funzioni anche cambiando lo Status da Zone1, Zone2, ecc.).

In entrambi i casi la macro:

1. legge il nuovo valore di Status;
2. determina il foglio di destinazione;
3. copia la riga (A‑M) in coda al foglio di destinazione;
4. elimina la riga originale dal foglio di partenza;
5. impedisce ricorsioni temporaneamente disattivando gli eventi.

Preparazione del foglio “Register”

1. Inserisci i tuoi dati da A a M, con intestazioni sulla riga 1 (consigliato).
2. Nella colonna Status applica la convalida dati con un elenco (gli elementi devono corrispondere ai nomi dei fogli di destinazione).
3. Assicurati che i fogli di destinazione (Zone1, Zone2, …) esistano e abbiano eventualmente la stessa riga di intestazione.

Versione base (spostamento dalla sola “Register”)

Questa versione è la più semplice: muove la riga solo quando cambi lo Status in Register. Se poi modifichi lo Status dal foglio Zone1, la riga non si sposta: per quello usa la “Versione pro” più sotto.

'  Codice da incollare nel modulo del foglio "Register" 
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const COL_STATUS As Long = 9     ' I = 9 (cambia se la lista è in un’altra colonna)
    Const FIRST_COL As Long = 1      ' A
    Const LAST_COL  As Long = 13     ' M
    Const HEADER_ROW As Long = 1     ' riga di intestazione
    On Error GoTo ErrHandler

    ' Interessa solo la/e cella/e modificate nella colonna Status
    Dim rng As Range
    Set rng = Intersect(Target, Me.Columns(COL_STATUS))
    If rng Is Nothing Then Exit Sub

    Application.EnableEvents = False

    Dim area As Range, c As Range
    Dim rowsToDelete As Collection: Set rowsToDelete = New Collection

    For Each area In rng.Areas
        Dim r As Long
        For r = area.Rows.Count To 1 Step -1
            Set c = area.Rows(r).Cells(1, 1)
            If c.Row > HEADER_ROW Then
                Dim destName As String: destName = Trim$(CStr(c.Value))
                If Len(destName) > 0 And Not IsError(c.Value) Then
                    Dim wsDest As Worksheet
                    On Error Resume Next
                    Set wsDest = Worksheets(destName)
                    On Error GoTo ErrHandler
                    If Not wsDest Is Nothing Then
                        Dim destRow As Long
                        destRow = wsDest.Cells(wsDest.Rows.Count, FIRST_COL).End(xlUp).Row
                        If destRow < HEADERROW + 1 Then destRow = HEADERROW
                        destRow = destRow + 1
                        Me.Range(Me.Cells(c.Row, FIRSTCOL), Me.Cells(c.Row, LASTCOL)).Copy _
                            Destination:=wsDest.Cells(destRow, FIRST_COL)
                        rowsToDelete.Add c.Row
                    Else
                        MsgBox "Errore: il foglio '" & destName & "' non esiste.", vbExclamation
                        c.ClearContents
                    End If
                End If
            End If
        Next r
    Next area

    ' Cancella le righe di partenza (in ordine decrescente per evitare salti)
    Dim i As Long, arr() As Long
    If rowsToDelete.Count > 0 Then
        ReDim arr(1 To rowsToDelete.Count)
        For i = 1 To rowsToDelete.Count: arr(i) = CLng(rowsToDelete(i)): Next i
        Dim j As Long, tmp As Long
        For i = LBound(arr) To UBound(arr) - 1
            For j = i + 1 To UBound(arr)
                If arr(j) > arr(i) Then tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
            Next j
        Next i
        For i = LBound(arr) To UBound(arr): Me.Rows(arr(i)).Delete: Next i
    End If

CleanExit:
    Application.EnableEvents = True
    Application.CutCopyMode = False
    Exit Sub

ErrHandler:
    MsgBox "Si è verificato un errore: " & Err.Description, vbExclamation
    Resume CleanExit
End Sub

Installazione passo per passo

1. Apri l’editor VBA con ALT + F11.
2. Nella finestra Project, fai doppio clic su Register.
3. In alto, seleziona Worksheet a sinistra e Change a destra.
4. Incolla il codice qui sopra.
5. Salva il file come .xlsm o .xlsb (macro abilitate).

Versione pro consigliata: spostamento da qualsiasi foglio

Questa variante centralizza la logica a livello di cartella di lavoro. In questo modo, se cambi lo Status da Zone1 a Zone2, la riga si muove automaticamente dal foglio corrente al nuovo foglio di destinazione.

Struttura della soluzione

• Un modulo standard con la routine MoveRowsByStatus (riutilizzabile e configurabile).
• Il modulo ThisWorkbook che intercetta Workbook_SheetChange e delega alla routine.
• (Opzionale) Un foglio Archivio per tenere traccia degli spostamenti (log).

Modulo standard: logica di spostamento

'  Modulo standard: "modMoveRows" 
Option Explicit

Public Const FIRST_COL As Long = 1          ' A
Public Const LAST_COL  As Long = 13         ' M
Public Const STATUS_COL As Long = 9         ' I (colonna Status)
Public Const HEADER_ROW As Long = 1         ' riga intestazioni
Public Const CREATESHEETIF_MISSING As Boolean = False
Public Const WRITE_LOG As Boolean = False   ' metti True se vuoi scrivere nel foglio "Archivio"
Public Const LOGSHEETNAME As String = "Archivio"

Private Type AppState
Events As Boolean
Screen As Boolean
Calc As XlCalculation
Alerts As Boolean
End Type

Private Sub SetAppState(ByRef st As AppState, ByVal suspend As Boolean)
If suspend Then
st.Events = Application.EnableEvents
st.Screen = Application.ScreenUpdating
st.Calc = Application.Calculation
st.Alerts = Application.DisplayAlerts
```
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.DisplayAlerts = False
Else
    Application.EnableEvents = st.Events
    Application.ScreenUpdating = st.Screen
    Application.Calculation = st.Calc
    Application.DisplayAlerts = st.Alerts
End If
```
End Sub

Public Sub MoveRowsByStatus(ByVal Sh As Worksheet, ByVal Target As Range)
' Sposta le righe (A-M) della/e cella/e modificate nella colonna STATUS_COL
Dim rng As Range: Set rng = Intersect(Target, Sh.Columns(STATUS_COL))
If rng Is Nothing Then Exit Sub
```
Dim st As AppState: SetAppState st, True
On Error GoTo ErrHandler

Dim rowsToDelete As Collection: Set rowsToDelete = New Collection
Dim area As Range, cell As Range

For Each area In rng.Areas
    Dim r As Long
    For r = area.Rows.Count To 1 Step -1
        Set cell = area.Rows(r).Cells(1, 1)
        If cell.Row > HEADER_ROW Then
            If Not IsError(cell.Value) Then
                Dim destName As String: destName = Trim$(CStr(cell.Value))
                If Len(destName) > 0 Then
                    Dim wsDest As Worksheet
                    Set wsDest = GetOrCreateDestination(destName)
                    If wsDest Is Nothing Then
                        MsgBox "Il foglio '" & destName & "' non esiste (creazione automatica disattivata).", vbExclamation
                        GoTo NextCell
                    End If
                    If StrComp(wsDest.Name, Sh.Name, vbTextCompare) = 0 Then GoTo NextCell ' niente da fare

                    Dim destRow As Long: destRow = NextFreeRow(wsDest, FIRST_COL)
                    ' Copia A-M nella prima riga libera del foglio di destinazione
                    Sh.Range(Sh.Cells(cell.Row, FIRST_COL), Sh.Cells(cell.Row, LAST_COL)).Copy wsDest.Cells(destRow, FIRST_COL)

                    ' Log (opzionale)
                    If WRITE_LOG Then AppendLog Sh, wsDest, cell.Row, destRow

                    ' Programma la cancellazione della riga originale
                    rowsToDelete.Add cell.Row
                End If
            End If
        End If
```
NextCell:
Next r
Next area
```
' Elimina le righe sorgenti in ordine decrescente
If rowsToDelete.Count > 0 Then
    Dim arr() As Long, i As Long, j As Long, tmp As Long
    ReDim arr(1 To rowsToDelete.Count)
    For i = 1 To rowsToDelete.Count: arr(i) = CLng(rowsToDelete(i)): Next i
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(j) > arr(i) Then tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
        Next j
    Next i
    For i = LBound(arr) To UBound(arr): Sh.Rows(arr(i)).Delete: Next i
End If
```
CleanExit:
SetAppState st, False
Application.CutCopyMode = False
Exit Sub

ErrHandler:
MsgBox "Errore: " & Err.Description, vbExclamation
Resume CleanExit
End Sub

Private Function GetOrCreateDestination(ByVal destName As String) As Worksheet
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Worksheets(destName)
On Error GoTo 0
```
If ws Is Nothing And CREATE_SHEET_IF_MISSING Then
    Set ws = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    ws.Name = destName
    ' Copia l’intestazione (opzionale)
    With ThisWorkbook.Worksheets(1)
        .Range(.Cells(HEADER_ROW, FIRST_COL), .Cells(HEADER_ROW, LAST_COL)).Copy ws.Cells(HEADER_ROW, FIRST_COL)
    End With
End If

Set GetOrCreateDestination = ws
```
End Function

Private Function NextFreeRow(ByVal ws As Worksheet, ByVal firstCol As Long) As Long
Dim last As Long
last = ws.Cells(ws.Rows.Count, firstCol).End(xlUp).Row
If last < HEADERROW + 1 Then last = HEADERROW
NextFreeRow = last + 1
End Function

Private Sub AppendLog(ByVal wsSrc As Worksheet, ByVal wsDst As Worksheet, _
ByVal srcRow As Long, ByVal dstRow As Long)
Dim wsLog As Worksheet
On Error Resume Next
Set wsLog = ThisWorkbook.Worksheets(LOGSHEETNAME)
On Error GoTo 0
If wsLog Is Nothing Then Exit Sub
```
Dim r As Long
r = wsLog.Cells(wsLog.Rows.Count, 1).End(xlUp).Row
If r &lt; 2 Then
    ' intestazione log
    wsLog.Range("A1:G1").Value = Array("Timestamp", "Utente", "Foglio Sorgente", "Riga Sorgente", "Foglio Destinazione", "Riga Destinazione", "Anteprima (col A)")
    r = 1
End If
r = r + 1
wsLog.Cells(r, 1).Value = Now
wsLog.Cells(r, 2).Value = Application.UserName
wsLog.Cells(r, 3).Value = wsSrc.Name
wsLog.Cells(r, 4).Value = srcRow
wsLog.Cells(r, 5).Value = wsDst.Name
wsLog.Cells(r, 6).Value = dstRow
wsLog.Cells(r, 7).Value = wsSrc.Cells(srcRow, FIRST_COL).Value
```
End Sub 

Modulo “ThisWorkbook”: intercetta i cambi su ogni foglio

'  Modulo "ThisWorkbook" 
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
On Error Resume Next
If Application.EnableEvents = False Then Exit Sub
' Delega la logica al modulo standard
MoveRowsByStatus Sh, Target
End Sub 

Installazione della versione pro

1. Apri ALT + F11.
2. Inserisci un Modulo (Inserisci → Modulo) e incolla il codice del modulo standard.
3. Nel nodo Microsoft Excel Objects apri ThisWorkbook e incolla il codice dell’evento Workbook_SheetChange.
4. Crea (opzionale) un foglio chiamato Archivio se vuoi il log.
5. Salva come .xlsm o .xlsb.

Personalizzazioni rapide

Necessità	Dove intervenire	Note
Status in un’altra colonna	STATUS_COL (es. 7 per la colonna G)	Usa numeri di colonna; A=1, B=2, …
Intervallo diverso da A‑M	FIRSTCOL, LASTCOL	Per A‑P imposta FIRSTCOL=1, LASTCOL=16.
Creare il foglio se manca	CREATESHEETIF_MISSING = True	La macro creerà il foglio e (opzionale) copierà l’intestazione.
Saltare la riga di intestazione	HEADER_ROW	Se l’intestazione è alla riga 2, metti HEADER_ROW=2.
Log degli spostamenti	WRITE_LOG = True e un foglio Archivio	Utile per audit e per ricostruire errori.
Valori lista ≠ nomi fogli	Funzione di mapping (es. ResolveDestinationName)	“Zona 1” → “Zone1”, ecc.

Perché la versione pro è più robusta

• Gestisce incolla multipla (pasti su più righe): i numeri di riga da eliminare vengono raccolti e processati dal basso verso l’alto.
• Evita ricorsioni: spegne/riaccende gli eventi nel blocco SetAppState.
• Funziona da ogni foglio: non obbliga l’utente a tornare in Register per cambiare lo Status.
• È configurabile: colonne, intestazioni, creazione fogli, log.

Spiegazione riga per riga (concetti chiave)

• Intersect(Target, Columns(STATUS_COL)): filtra l’evento alle sole celle di Status.
• Application.EnableEvents = False: disattiva gli eventi per evitare che la copia e l’eliminazione riattivino la macro.
• .End(xlUp).Row: trova l’ultima riga usata in una colonna (qui la “A”).
• Eliminazione in ordine decrescente: impedisce che l’eliminazione di una riga alteri gli indici delle righe successive da cancellare.
• Controlli anti‑errore: salta celle vuote o con errori (#N/D, #VALORE!, …).

Variante con Tabelle strutturate (ListObject)

Se i tuoi dati sono in una Tabella di Excel (Home → Formatta come Tabella), puoi riferirti alle colonne per nome invece che per indice. Questo rende la macro meno fragile quando sposti colonne.

'  Esempio: usare il nome colonna "Status" in una Tabella "tblRegister" 
Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    On Error Resume Next
    If Application.EnableEvents = False Then Exit Sub

    Dim lo As ListObject
    On Error Resume Next
    Set lo = Sh.ListObjects("tblRegister")
    On Error GoTo 0
    If lo Is Nothing Then Exit Sub

    Dim colStatus As Long
    colStatus = lo.ListColumns("Status").Range.Column

    Dim rng As Range: Set rng = Intersect(Target, Sh.Columns(colStatus))
    If rng Is Nothing Then Exit Sub

    ' Riusa la logica generica definendo dinamicamente la colonna Status
    STATUSCOL = colStatus   ' richiede che STATUSCOL sia Public in un modulo
    MoveRowsByStatus Sh, rng
End Sub

Nota: per questo snippet fai in modo che STATUS_COL sia una variabile Public nel modulo standard.

Best practice di implementazione

• Nominare coerentemente i fogli: i valori dell’elenco devono combaciare esattamente con i nomi dei fogli (maiuscole/minuscole indifferenti se usi vbTextCompare).
• Bloccare layout: proteggi la riga d’intestazione, evita che gli utenti spostino colonne senza aggiornare le costanti.
• Ridurre i ricalcoli: in file pesanti imposta Application.Calculation = xlCalculationManual durante l’operazione (già gestito nella versione pro).
• Convalida dati: usa un elenco dinamico univoco dei fogli di destinazione per minimizzare gli errori di digitazione.
• Distribuzione: salva come .xlsm firmato digitalmente se devi condividerlo in azienda.

Tabella di mapping (se i nomi non coincidono)

Se l’elenco mostra etichette “umane” ma i fogli hanno nomi tecnici, mappa i valori nella funzione ResolveDestinationName (mostrata nella versione pro). Esempio di mapping:

Valore nell’elenco	Nome foglio	Motivo
Zona 1	Zone1	Rimuovere spazi e uniformare i nomi.
Zona 2	Zone2	Coerenza con nomi pre‑esistenti.
In Lavorazione	WIP	Terminologia interna vs. display utente.

Controlli di qualità e collaudo

1. Test singolo: cambia lo Status in Register e verifica lo spostamento.
2. Test incolla multipla: incolla Status diversi su più righe: tutte le righe devono andare a destinazione.
3. Test su foglio di zona (solo versione pro): cambia lo Status in Zone1 e verifica il salto su Zone2.
4. Test foglio mancante: seleziona uno Status senza foglio. Comportamento atteso:
   • versione base: avviso e pulizia della cella;
   • versione pro: avviso; se CREATESHEETIF_MISSING = True viene creato il foglio.
5. Test Excel in rete: verifica la velocità con file su SharePoint/OneDrive; valuta il log per traccia.

Troubleshooting (problemi comuni)

1. “Non succede nulla”
   • La macro è stata incollata in un Modulo standard invece che nel modulo del foglio (versione base) o in ThisWorkbook (versione pro).
   • Application.EnableEvents è rimasto False dopo un crash: apri l’Immediate Window (CTRL + G) e digita Application.EnableEvents = True.
2. Errore “Subscript out of range”
   • Il valore scelto nell’elenco non corrisponde a un foglio esistente e la creazione automatica è disattivata.
   • Verifica ortografia, spazi, accenti.
3. Difficoltà a fare “Annulla”
   • Dopo l’esecuzione di una macro non è disponibile CTRL + Z. Usa il foglio Archivio come log per ripristini manuali o crea una macro di undo su misura.
4. Le righe finiscono nel “posto sbagliato”
   • Controlla FIRSTCOL / LASTCOL e che la colonna Status sia quella corretta (STATUS_COL).
5. Lentezza con molte righe
   • Usa la versione pro: spegne lo schermo e imposta calcolo manuale mentre lavora.
   • Considera di spostare solo valori e formati (la copia standard li mantiene); evita formule voluminose se inutili.

Checklist pronta all’uso

• Imposta la convalida dati in Status con i nomi dei fogli.
• Decidi se usare versione base (solo Register) o versione pro (tutti i fogli).
• Configura STATUSCOL, FIRSTCOL, LASTCOL, HEADERROW.
• Attiva CREATESHEETIF_MISSING se vuoi la creazione automatica.
• (Opzionale) Aggiungi il foglio Archivio e imposta WRITE_LOG = True.
• Salva come .xlsm/.xlsb, testa i casi tipici e distribuisci.

Domande frequenti

Posso muovere righe che non iniziano da A o non finiscono a M?
Sì: modifica FIRSTCOL e LASTCOL. Per esempio, per copiare D‑Q usa 4 e 17.

Se rinomino un foglio, devo cambiare la lista?
Sì: i valori della convalida dati devono corrispondere ai nuovi nomi. In alternativa, usa una funzione di mapping.

La macro può creare automaticamente i fogli?
Sì: imposta CREATESHEETIF_MISSING = True. Verranno creati alla prima occorrenza.

Posso limitare lo spostamento solo a determinate righe?
Puoi aggiungere una condizione (es. “sposta solo se la colonna H = ‘OK’”). Inserisci il controllo prima della copia.

Funziona su Mac?
Sì, in Excel per Mac le API VBA usate sono supportate. Ricorda di salvare in formato con macro e di abilitare le macro nelle preferenze.

Esempio completo con mapping e fogli auto‑creati

Per chi desidera una versione “chiavi in mano” che mappi “Zona 1”→“Zone1” e crei i fogli mancanti:

'  Modulo standard "modMoveRowsFull" 
Option Explicit

Public Const FIRST_COL As Long = 1
Public Const LAST_COL  As Long = 13
Public Const STATUS_COL As Long = 9
Public Const HEADER_ROW As Long = 1
Public Const CREATESHEETIF_MISSING As Boolean = True

Public Sub MoveRowsByStatusFull(ByVal Sh As Worksheet, ByVal Target As Range)
Dim rng As Range: Set rng = Intersect(Target, Sh.Columns(STATUS_COL))
If rng Is Nothing Then Exit Sub
```
Dim prevEvents As Boolean: prevEvents = Application.EnableEvents
Dim prevCalc As XlCalculation: prevCalc = Application.Calculation
Dim prevScreen As Boolean: prevScreen = Application.ScreenUpdating
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

On Error GoTo FINE

Dim area As Range, c As Range
Dim toDelete As Collection: Set toDelete = New Collection

For Each area In rng.Areas
    For Each c In area.Cells
        If c.Row > HEADER_ROW And Not IsError(c.Value) Then
            Dim statusText As String: statusText = Trim$(CStr(c.Value))
            If Len(statusText) > 0 Then
                Dim dest As String: dest = ResolveStatus(statusText)
                Dim ws As Worksheet: Set ws = EnsureSheet(dest)
                If ws Is Nothing Then
                    MsgBox "Impossibile creare o trovare il foglio '" & dest & "'.", vbExclamation
                ElseIf StrComp(ws.Name, Sh.Name, vbTextCompare) <> 0 Then
                    Dim r As Long: r = ws.Cells(ws.Rows.Count, FIRST_COL).End(xlUp).Row
                    If r < HEADER_ROW + 1 Then r = HEADER_ROW
                    r = r + 1
                    Sh.Range(Sh.Cells(c.Row, FIRST_COL), Sh.Cells(c.Row, LAST_COL)).Copy ws.Cells(r, FIRST_COL)
                    toDelete.Add c.Row
                End If
            End If
        End If
    Next c
Next area

' Elimina le righe (in ordine decrescente)
Dim i As Long, j As Long, tmp As Long, arr() As Long
If toDelete.Count > 0 Then
    ReDim arr(1 To toDelete.Count)
    For i = 1 To toDelete.Count: arr(i) = CLng(toDelete(i)): Next
    For i = 1 To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(j) > arr(i) Then tmp = arr(i): arr(i) = arr(j): arr(j) = tmp
        Next j
    Next i
    For i = LBound(arr) To UBound(arr): Sh.Rows(arr(i)).Delete: Next i
End If
```
FINE:
Application.EnableEvents = prevEvents
Application.Calculation = prevCalc
Application.ScreenUpdating = prevScreen
Application.CutCopyMode = False
End Sub

Private Function ResolveStatus(ByVal s As String) As String
Select Case UCase$(s)
Case "ZONA 1", "ZONE1": ResolveStatus = "Zone1"
Case "ZONA 2", "ZONE2": ResolveStatus = "Zone2"
Case Else: ResolveStatus = s
End Select
End Function

Private Function EnsureSheet(ByVal name As String) As Worksheet
On Error Resume Next
Set EnsureSheet = ThisWorkbook.Worksheets(name)
On Error GoTo 0
If EnsureSheet Is Nothing And CREATESHEETIF_MISSING Then
Set EnsureSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
EnsureSheet.Name = name
' Copia intestazioni dalla prima sheet (se esistono)
With ThisWorkbook.Worksheets(1)
.Range(.Cells(HEADERROW, FIRSTCOL), .Cells(HEADERROW, LASTCOL)).Copy _
EnsureSheet.Cells(HEADERROW, FIRSTCOL)
End With
End If
End Function 

'  ThisWorkbook 
Option Explicit
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Application.EnableEvents = False Then Exit Sub
    MoveRowsByStatusFull Sh, Target
End Sub

Prestazioni: consigli pratici

• Schermo e calcolo: la versione pro già disattiva lo schermo e imposta il calcolo manuale per accelerare gli spostamenti massivi.
• Operare in batch: evitare .Select/.Activate; lavorare su range e array.
• Archivio separato: se scrivi un log dettagliato (più colonne), valuta di farlo in un’unica Write con un array per evitare molte operazioni di I/O.

Modello di foglio “Archivio” (facoltativo)

Crea un foglio chiamato Archivio con le seguenti intestazioni:

A	B	C	D	E	F	G
Timestamp	Utente	Foglio Sorgente	Riga Sorgente	Foglio Destinazione	Riga Destinazione	Anteprima (col A)

In questo modo, ogni spostamento lascia una traccia con data/ora e utente Windows (proprietà Application.UserName).

Consigli di sicurezza e distribuzione

• Centro protezione: abilita macro solo per file affidabili; in azienda valuta la firma digitale del progetto VBA.
• Backup: se il flusso è critico, crea una macro di backup (copia preventiva nel foglio Archivio o in un file CSV) prima della cancellazione.
• Controlli di business: aggiungi regole (es. impedire lo spostamento verso fogli “chiusi” o archiviati).

In sintesi

Con una macro VBA leggera e “evento‑driven” puoi automatizzare il flusso: scegli lo Status dal menu a discesa e l’intera riga migra nel foglio corrispondente eliminandosi dall’origine. La versione base copre l’uso più comune da Register; la versione pro intercetta i cambi su tutta la cartella, gestisce incolla multipla, previene ricorsioni e offre opzioni come creazione automatica dei fogli e log degli spostamenti. Con le personalizzazioni proposte (colonne, mapping, tabelle strutturate) puoi adattare la soluzione al tuo modello dati in modo affidabile e scalabile.

---