Google Groups no longer supports new Usenet posts or subscriptions. Historical content remains viewable.
Dismiss

Filtrare su più fogli

584 views
Skip to first unread message

visual

unread,
May 10, 2010, 2:38:01 PM5/10/10
to
Buonasera a tutto il NG.

Chiedevo cortesemente un aiuto per poter applicare questa macro che ho
copiato e modificato per poterla applicare per le mie esigenze.
Adesso avrei la necessità di dover filtrare su più fogli, tutti uguali
secondo lo schema del codice, e copiare sempre su uno. Ho cercato di fare
qualche modifica senza riuscirci.
Grazie ed un cordiale saluto a tutti.

N.B. : è un vero peccato che per Voi che fate tutto questo con passione ed
impegno aiutando gli altri, debba in qualche maniera finire. Ma credo che la
Vs tenacia sia superiore alle decisioni di chi vuole ciò.


===========>

Option Explicit

Public Sub mCopia()

'dichiaro le variabili
Dim wk As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim v As Variant

'inserisco il criterio di ricerca e impedisco
'lo sfarfallio del monitor
With Application
v = .InputBox("Inserire il criterio di ricerca.")
.ScreenUpdating = False
End With
'metto un riferimento al workbook
'che contiene il codice
Set wk = ThisWorkbook
'metto un riferimento ai fogli;
'Foglio1 dove ho la tabella da cui
'copiare i dati, Foglio2 dove voglio
'incollare i dati filtrati
With wk
Set sh1 = .Worksheets("Foglio1")
Set sh2 = .Worksheets("Foglio2")
End With
'eseguo il filtro/copia/incolla
With sh1
'metto il filtro automatico e gli passo
'come criterio quanto inserito nella
'InputBox
.Range("A10:J177").AutoFilter Field:=10, _
Criteria1:=CStr(v)
'elimino tutti i dati presenti
'nel Foglio2
sh2.Cells.Clear
'copio/incollo
.Range("A11:J177").Copy _
Destination:=sh2.Range("A9")
'tolgo il filtro
.Range("A10").AutoFilter
End With

'ripristino l'aggiornamento del monitor
With Application
.ScreenUpdating = True
End With

'Set a Nothing delle variabili oggetto
Set sh2 = Nothing
Set sh1 = Nothing
Set wk = Nothing

End Sub


Mauro Gamberini

unread,
May 11, 2010, 3:16:08 AM5/11/10
to
> Chiedevo cortesemente un aiuto per poter applicare questa macro che ho
> copiato e modificato per poterla applicare per le mie esigenze.
> Adesso avrei la necessità di dover filtrare su più fogli, tutti uguali
> secondo lo schema del codice, e copiare sempre su uno. Ho cercato di fare
> qualche modifica senza riuscirci.
> Grazie ed un cordiale saluto a tutti.
>

Puoi, per favore, spiegare cosa intendi per più fogli?
Grazie.

--
---------------------------
Mauro Gamberini
Microsoft MVP - Excel
http://www.riolab.org/
http://www.maurogsc.eu/
http://social.answers.microsoft.com/Forums/it-IT/officeexcelit/threads


__________ Informazioni da ESET NOD32 Antivirus, versione del database delle firme digitali 5103 (20100510) __________

Il messaggio � stato controllato da ESET NOD32 Antivirus.

www.nod32.it

visual

unread,
May 11, 2010, 5:40:01 AM5/11/10
to

"Mauro Gamberini" wrote:

Buongiorno Mauro, grazie per l'interessamento.
Io ho in un file 12 fogli ( nominati ) + 1 foglio che è quello utilizzato
per la copia
che potrei nominare come Riepilogo.
Sostanzialmente io devo fare questo:
filtrare secondo il criterio e copiare sul 13° foglio( Riepilogo), stamparlo
e passare al successivo e così di seguito.
Mi auguro di essere stato chiaro.Grazie.

Mauro Gamberini

unread,
May 11, 2010, 6:01:31 AM5/11/10
to
> Buongiorno Mauro, grazie per l'interessamento.
> Io ho in un file 12 fogli ( nominati ) + 1 foglio che è quello utilizzato
> per la copia
> che potrei nominare come Riepilogo.
> Sostanzialmente io devo fare questo:
> filtrare secondo il criterio e copiare sul 13° foglio( Riepilogo),
> stamparlo
> e passare al successivo e così di seguito.
> Mi auguro di essere stato chiaro.Grazie.
>

La mcro che hai postato(carina!) si riferisce ad un foglio
specifico da filtrare e da cui prelevare i dati.
Volendo *astrarla* , possiamo modificarla così:

Public Sub mCopia()

'dichiaro le variabili
Dim wk As Workbook
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim v As Variant

'inserisco il criterio di ricerca e impedisco
'lo sfarfallio del monitor
With Application
v = .InputBox("Inserire il criterio di ricerca.")
.ScreenUpdating = False
End With
'metto un riferimento al workbook
'che contiene il codice
Set wk = ThisWorkbook
'metto un riferimento ai fogli;

'ActiveSheet il Foglio attivo e
' dove ho la tabella da cui
'copiare i dati, Riepilogo dove voglio


'incollare i dati filtrati
With wk

Set sh1 = ActiveSheet
Set sh2 = .Worksheets("Riepilogo")

End Sub

Ora non controllo più quale sia il foglio attivo,
quindi esegue la macro su qualsiasi foglio.
Ho però io alcune domande.
Devi per caso filtrare e accodare i dati di *tutti*
i fogli nel foglio Riepilogo?
Esempio, elimino tutto dal foglio Riepilogo
e poi metto i dati di tutti i fogli con il filtro
fatto con la InputBox nel foglio Riepilogo e lo mando
in stampa?
Oppure vuoi stampare uno per uno i dati di ogni foglio?


__________ Informazioni da ESET NOD32 Antivirus, versione del database delle firme digitali 5104 (20100511) __________

visual

unread,
May 11, 2010, 7:20:01 AM5/11/10
to

"Mauro Gamberini" wrote:

Grazie Mauro, ero sicuro che ti sarebbe piaciuta.....

> Ora non controllo più quale sia il foglio attivo,
> quindi esegue la macro su qualsiasi foglio.

in effetti io per ogni foglio dovrei eseguire la macro ed inserire il
criterio( riferito
ai mesi).
Chiedevo: non fa nulla se i fogli sono tutti nominati?

> Devi per caso filtrare e accodare i dati di *tutti*
> i fogli nel foglio Riepilogo?

no

> Oppure vuoi stampare uno per uno i dati di ogni foglio?

si, foglio1 filtro, copio su riepilogo, stampo e passo al successivo con la
stessa modalità.
Spero che sia stato chiaro.
Mille grazie.

visual

unread,
May 11, 2010, 9:34:01 AM5/11/10
to

"visual" wrote:

Ciao Mauro, ho provato la macro e va benissimo così come l'hai creata.
Ora però ho un problema:
nel foglio di riepilogo ho impostato una maschera, che dovrebbe rimanere
sempre la stessa ogni qualvolta io copio su questo foglio dagli altri e
stampo.
Le righe copiate partono, come impostato da macro, in A9. Avendo impostato
successivamente questa maschera, ovviamente ( che stupido che sono ) viene
cancellata.

>> 'elimino tutti i dati presenti
> > 'nel Foglio2
> > sh2.Cells.Clear

ho provato nel frattempo a fare qualche modifica ma mi va in errore.
Potresti darmi questo ultimo aiuto.
Sentitamente ringrazio.

Mauro Gamberini

unread,
May 11, 2010, 10:10:10 AM5/11/10
to
Questa dovrebbe funzionare... dovrebbe, non l'ho testata.

Una UserForm con una ComboBox dove andremo ma mettere
i nomi dei fogli(meno Riepilogo).
Una TextBox dove metterai il valore da ricercare per il filtro.
Un CommandButton che esegue il filtro.
In pratica selezioni il foglio, inserisci il filtro, e via.

Codice della UserForm:

Private Sub UserForm_Initialize()
Dim sh As Worksheet
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Riepilogo" Then
Me.ComboBox1.AddItem sh.Name
End If
Next
Set sh = Nothing
End Sub

Private Sub CommandButton1_Click()
Call mCopia(ThisWorkbook.Worksheets(Me.ComboBox1.Text), _
Me.TextBox1.Text)
End Sub

Private Sub mCopia(ByRef sh As Worksheet, ByVal v As Variant)

'dichiaro le variabili
Dim shRiepilogo As Worksheet

'impedisco lo sfarfallio del monitor
With Application


.ScreenUpdating = False
End With

'metto un riferimento al foglio Riepilogo;
Set shRiepilogo = ThisWorkbook.Worksheets("Riepilogo")

'eseguo il filtro/copia/incolla
With sh


'metto il filtro automatico e gli passo

'come criterio quanto selezionato nella TextBox


.Range("A10:J177").AutoFilter Field:=10, _
Criteria1:=CStr(v)
'elimino tutti i dati presenti

'nel Riepilogo
shRiepilogo.Cells.Clear


'copio/incollo
.Range("A11:J177").Copy _

Destination:=shRiepilogo.Range("A9")


'tolgo il filtro
.Range("A10").AutoFilter
End With

'ripristino l'aggiornamento del monitor
With Application
.ScreenUpdating = True
End With

'Set a Nothing delle variabili oggetto

Set shRiepilogo = Nothing

End Sub

Qui trovi il file di excel utilizzato per l'esempio.
Occhio che non ci sono dati, è solo un esempio per
la UserForm:
http://www.maurogsc.eu/prove/userformperfiltro.zip


__________ Informazioni da ESET NOD32 Antivirus, versione del database delle firme digitali 5105 (20100511) __________

visual

unread,
May 12, 2010, 6:34:01 AM5/12/10
to

"Mauro Gamberini" wrote:

Buongiorno Mauro, funziona benissssssimo.
Era proprio quello che desideravo e avevo( inutilmente ) cercato di fare.
Ho solo fatto un paio di modifiche per adattarla alle mie esigenze:

> 'elimino tutti i dati presenti
> 'nel Riepilogo
> shRiepilogo.Cells.Clear
> 'copio/incollo
> .Range("A11:J177").Copy _
> Destination:=shRiepilogo.Range("A9")

con

> 'elimino tutti i dati presenti
> 'nel Riepilogo

> shRiepilogo.Range("A9:J32").Clear
> 'copio/incollo
> .Range("A11:IJ177").Copy _
> Destination:=shRiepilogo.Range("A9")

in maniera tale che la maschera che ho nel foglio" Riepilogo " non viene
cancellata,
copio fino alla col I e stampo.
La col J ( il criterio da filtrare ) che ha come dato i mesi, viene
richiamata nella maschera del foglio " Riepilogo " da un elenco a discesa.
Poi ho collegato l'userform ad un pulsante e via....

Infinatemente grato....

visual

unread,
May 12, 2010, 6:52:01 AM5/12/10
to

"Mauro Gamberini" wrote:

Buongiorno Mauro, funziona benissssimo.
Era in realtà quello che avevo( inutilmente ) cercato di realizzare.
Ho solo apportato un paio di modifiche e poi aggiunto un pulsante per
richiamare l'UserForm:

> 'elimino tutti i dati presenti
> 'nel Riepilogo
> shRiepilogo.Cells.Clear
> 'copio/incollo
> .Range("A11:J177").Copy _
> Destination:=shRiepilogo.Range("A9")

in

> 'elimino tutti i dati presenti
> 'nel Riepilogo

> shRiepilogo.Range("A9:J32").Clear
> 'copio/incollo

> .Range("A11:I177").Copy _
> Destination:=shRiepilogo.Range("A9")

così nel foglio "Riepilogo" non mi viene cancellata la maschera che ho
impostato per la stampa,
copio fino alla col I,
mentre la col J ( il criterio da filtrare ), il cui dato è rappresentato dai
mesi, viene richiamata da un elenco a discesa nella maschera del foglio "
Riepilogo ".
......Infinitamente grato

0 new messages