Allora, sfruttando i chiarimenti derivanti dai messaggi di/a Ricky, e con tutti i dubbi del caso...
Una macro come questa:
- Codice: Seleziona tutto
Sub spalma()
Dim myCols As String, myRan As Range, myMatch
'
myCols = "A:K" '<<< Le colonne da trasferire
'
Set myRan = Application.Intersect(Range(myCols), ActiveCell.EntireRow)
If Cells(ActiveCell.Row, "E") = "" Or Cells(ActiveCell.Row, "A") = "" Then 'Controlla che col A e E non siano vuote
beep
myRan.Interior.Color = RGB(255, 200, 200)
' MsgBox ("Riga non completa")
Exit Sub
End If
Set myRan = Application.Intersect(Range(myCols), ActiveCell.EntireRow)
myMatch = Application.Match(myRan.Cells(1, "A"), Sheets(myRan.Cells(1, "E").Value).Range("A1:A1000"), 0)
If IsError(myMatch) Then
myRan.Cells(1, "H").Value = Chr(149) & Chr(149) & " Da Evadere"
Sheets(myRan.Cells(1, "E").Value).Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Resize(1, Range(myCols).Columns.Count).Value = _
myRan.Value
myRan.Cells(1, 1).Offset(-1, Range(myCols).Columns.Count).Copy _
myRan.Cells(1, 1).Offset(0, Range(myCols).Columns.Count)
myRan.Interior.Color = RGB(200, 255, 200)
myRan.Range("A1").Offset(1, 0).Select
Else
Exit Sub
myRan.Select
MsgBox ("Record gia' presente: " & vbCrLf & "Protocollo: " & myRan.Cells(1, "A") & _
vbCrLf & "Foglio: " & myRan.Cells(1, "E") & vbCrLf & _
"COPIA DEL RECORD NON EFFETTUATA")
Exit Sub
End If
End Sub
Personalizza la riga marcata <<<
La macro trasferisce la RIGA CORRENTE nel foglio indicato dalla colonna E, poi colora la riga in verdino e inserisce una formula nella colonna adiacente all' ultima copiata.
Il foglio di destinazione deve esistere; pertanto e' opportuno che in col E inserisci una convalida da un elenco che contiene solo le tipologie ammesse, e a ogni tipologia che aggiungi ti premunisci di inserire il relativo foglio di lavoro.
La formula ha lo scopo di riportare dal foglio di tipologia l' eventuale aggiornamento dello status Da evadere /Evaso.
La macro assume che lo stato di una nuova linea sia "Da evadere", e inserisce questo valore in colonna H aggiungendo in testa due caratteri speciali che dovrebbero visualizzarsi come "pallino"; la presenza di questi pallini, insieme alla colorazione della riga e alla replica di questo stato nella colonna con la formula dovrebbe confermare che la copia della riga e' stata correttamente effettuata nel foglio di destinazione.
Numeri di protocollo gia' presenti nel foglio Tipologia non verranno ri-ricopiati e sara' emesso un messaggio di "COPIA DEL RECORD NON EFFETTUATA".
Prima della copia la macro verifica che colonna A ed E siano non vuoti, e se li trova vuoti colora la riga di rossiccio e non procede; se vuoi anche un messaggio allora elimina l' apostrofo in testa alla linea MsgBox ("Riga non completa").
E' necessario che in L1 sia inserita la formula
- Codice: Seleziona tutto
=CERCA.VERT(A1;INDIRETTO(E1&"!A1:H10");8;0)
e che essa sia copiata manualmente sulle righe gia' trasposte nei vari fogli di tipologia.
In alternativa usi questa macro per copiare sui fogli Tipologia le pratiche che hai finora protocollato, partendo da fogli che hanno solamente l' intestazione in riga 1:
- Codice: Seleziona tutto
Sub UnaTantum()
'
Sheets("pratiche totali ").Activate
Stop
MsgBox ("ATTENZIONE: Questa macro deve essere eseguita solo per una volta")
Stop
Stop
For I = 2 To Cells(Rows.Count, "E").End(xlUp).Row
Cells(I, 1).Select
Call spalma
Next I
End Sub
(i vari Stop servono per evitare una esecuzione accidentale della macro)
TUTTAVIA in questo modo eventuali status appliacati sui fogli Tipologia verrano rimossi, perche' gli elenchi vengono ricreati da zero.
In alternativa:
-lasci gli elenchi esistenti e usi un diverso I iniziale in For I = 2 To della sub UnaTantum, ad esempio per copiare solo i record da riga 1000 (For I=1000 to etc etc). In questo caso devi copiare la formula da L2 fino alla riga da cui la macro iniziera' a suddividere.
oppure
-lasci gli elenchi esistenti, copi la formula da L1 fino all' ultima riga dell' elenco, togli l' apostrofo in testa all' istruzione
Exit Sub subito dopo
Else, usi
For I = 2 To etc etc in Sub UnaTantum
In questo modo le righe gia' presenti nel foglio Tipologia non saranno uteriormente copiate, senza che venga emesso il messaggio "COPIA DEL RECORD NON EFFETTUATA".
Puo' essere utile dare a tutte le righe senza il colore verdino (che sara' assegnato ai soli record ricopiati durante la UnaTantum) lo stesso colore verdino.
Completata l' esecuzione di UnaTantum rimettere l' apostrofo al suo posto.
La Sub spalma non viene eseguita automaticamente quando una riga viene compilata; puo' essere utile assegnargli un tasto di scelta rapida (piu' che associarla a un pulsante): da Excel, Alt-F8; selezionare palma dall' elenco, premere Opzioni; nella casella Tasto di scelta rapida inserire ad esempio Maiusc-S; Ok, chiudi l' elenco con la X.
In questo modo per eseguire la macro ti bastera' posizionarti sulla riga da copiare (qualsiasi cella della riga) e premere Contr-Maiusc-S.
La procedura non e' secondo me idonea per garantire risultati certificabili, ma va nella direzione richiesta dal capo.
Ciao
Registrazione
