[Excel] Problema filtro colonna Tabella

[marte1503]

Ciao a tutti

In foglio21 ho “Tabella1” di 152 colonne (e 5 righe destinate ad aumentare), intervallo provvisorio B4:EX8.
Nelle celle di colonna 130 posso trovare scritti 4 diversi valori (giallo, verde, rosso e azzurro in ordine casuale).

Con il registratore ho creato 4 macro che attivo premendo 4 pulsanti.
Queste 4 macro sfruttano il filtro presente in testa alla (colonna 130 denominata Colore). Il risultato della scrematura viene copiato e viene incollato (incolla speciale Valori) in 4 griglie abbinate al rispettivo colore.

Quando in colonna 130 sono presenti tutti e 4 i valori (nome dei colori), funziona tutto perfettamente, nel senso che se premo un pulsante (per esempio il giallo) la Tabella viene filtrata correttamente, e nella Griglia gialla vengono incollati i risultati gialli, lo stesso accade per gli altri 3 casi (colori).

Veniamo al problema :

Se nella colonna 130 ho soltanto 3 colori,(ipotizziamo manchi il GIALLO) e premo proprio quel pulsante, la macro incolla nella (Griglia gialla in foglio15) tutti i risultati presenti in Tabella senza distinzione, quindi finisco col trovare inseriti in Griglia gialla anche i risultati azzurro verde e rosso, invece dovrei vedere la Griglia vuota
(Gli altri colori invece eseguono i passaggi correttamente e i risultati sono giusti).

Come posso fare per evitare il problema?

E’ un po’ complicato… Spero si capisca bene quello che ho detto…
Grazie
Marte1503

[Flash30005]

Sai perché è complicato?

perché ti sei fatto una domanda e ti sei dato una risposta (un po' alla Marzullo)
e ora chiedi del perché (?)

A questo punto a lavoro fatto e non funzionante perfettamente ti chiedo di inviare il file completo di macro per poter intervenire su quel progetto, a meno che non pretenda che mi costruisca un progetto simile al tuo per dirti dove intervenire!

Ciao

[Anthony47]

Direi che invece del file completo (richiesto da Flash, vedi sopra) in prima battuta potresti pubblicare il codice della macro con cui filtri per "Giallo".

Ciao

[marte1503]

Ciao e grazie.
Ecco la Sub

Codice: Seleziona tutto

Sub VaiAclasseGIALLA()
'
' VaiAclasseGIALLA Macro
'

'il pulsante che attiva questa macro è inserito in foglio3
    Sheets("Foglio15").Select
    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
    Range("C6:U30").ClearContents   'pulisco il range Griglia
    Sheets("Foglio21").Select   'vado al foglio Tabella
    ActiveSheet.Unprotect
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=40
           'Rimuovo il filtro 40 potenzialmente già attivato da altre macro
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=135, Criteria1 _
        :="Disco GIALLO"   'filtro i risultati Gialli
    Range("Tabella1[Nome Bambino/a]:Tabella1[Delegati3+NumeroTel]").Select
    Selection.Copy  'copio il range che incollerò in Griglia
    Sheets("Foglio15").Select   'vado al foglio Griglia Gialla
    Cells(6, 3).Select   'seleziono il punto dove andrò a incollare i valori copiati
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Sheets("Foglio21").Select
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=135
          'rimuovo il filtro attivato in precedenza
   
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    Cells(1, 2).Select
    Sheets("Foglio15").Select
    Cells(2, 2).Select
    Application.ScreenUpdating = True

End Sub

Ricordo che la macro così come formulata funziona regolarmente se all’interno di Colonna 135 (NON 130 COME DICEVO NEL POST PRECEDENTE) esistono già tutti e 4 i criteri (colori). L’errore nell’incollare i dati in Griglia avviene se la macro non trova il criterio “Disco GIALLO” perché non ancora presente in elenco.

Per maggiore chiarezza ripeto la richiesta:

se premo erroneamente o volontariamente il pulsante giallo la macro deve portarmi al foglio Griglia Gialla(foglio15) senza incollare nessun valore, Griglia che in questo caso ovviamente dovrà apparire vuota.

Grazie dell’aiuto
Marte

[Anthony47]

Hum, non ci avevo mai fatto caso che selezionando un' area filtrata vuota mi restituisce l' intera area.
Prova questa modifica:

Codice: Seleziona tutto

'    Range("Tabella1[Nome Bambino/a]:Tabella1[Delegati3+NumeroTel]").Select    '<<<Eliminata
'le prossime sono aggiunte
On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella1[Nome Bambino/a]:Tabella1[Delegati3+NumeroTel]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If not myFiltr Is Nothing Then
myFiltr.Select
    Selection.Copy  'copio il range che incollerò in Griglia
        Sheets("Foglio15").Select   'vado al foglio Griglia Gialla
        Cells(6, 3).Select   'seleziono il punto dove andrò a incollare i valori copiati
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
End If
        Sheets("Foglio15").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        Sheets("Foglio21").Select                                                'DA QUI CONTINUA IL TUO CODICE
        ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=135
'etc etc


Ciao

[marte1503]

Ciao Anthony,

Grazie 1000 per la modifica, problema risolto!
Ora funziona tutto perfettamente

Ciao
Marte

[marte1503]

Ciao Anthony,

tra 100 prove, registrazioni di macro e rimaneggiamenti vari per adattare la soluzione che mi hai dato nel post precedente alla nuova esigenza sono riuscito a mettere insieme una macro quasi funzionante, ma purtroppo non so come si scrive un comando essenziale per il funzionamento totale…

Ti chiedo ancora una mano..

Il problema è che devo inserire il risultato di due Tabella filtrate in una Tabella a sua volta filtrata(Tabella1) operazione che ho pensato di fare in due tempi, prima copiando da Tabella10 poi dalla11.

Nelle 2 righe evidenziate così : <<<<<<<<<<<<<<<<<<<<<QUI
ho bisogno un comando che rilevi da solo (in Tabella1) il numero della prima Riga che ottengo dopo averla filtrata, Riga sulla quale si andranno ad incollare i risultati copiati da Tabella10 e da Tabella 11
(la scritta Cells(14, 48).Select e Cells(10, 48).Select che vedi ora le ho inserite manualmente……

una volta azzeccata la prima riga dovrebbe andare a posto tutto come voglio.

Questa la macro:

Codice: Seleziona tutto

'Pulsante di attivazione in foglio8

    Sheets("Foglio21").Select
    ActiveSheet.Unprotect
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=40, Criteria1:= _
        "M"
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=47, Criteria1:= _
        "=Nuovo_Iscritto_BRUCHINO", Operator:=xlOr, Criteria2:= _
        "=Nuovo_Iscritto_COCCINELLA"
           'sopra ho filtrato Tabella1
       
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella1[Inquadratura]:Tabella1[Colore Classe]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Range("Tabella1[Inquadratura]:Tabella1[Colore Classe]").Select 'seleziono le 2 colnne adiacenti
Selection.ClearContents 'cancello il range Tabella
End If


Sheets("Foglio90").Select
   ActiveSheet.ListObjects("Tabella10").Range.AutoFilter Field:=1, Criteria1:= _
        "<>" 'in questa tabella esistono solo 2 criteri (Piccoli o Superpiccoli)
         On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella10[Inquadratura]:Tabella10[COLORE Classe]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Range("Tabella10[Inquadratura]:Tabella10[COLORE Classe]").Select 'seleziono il range
Selection.Copy 'copio il range che incollerò in Tabella
Sheets("Foglio21").Select 'vado al foglio Tabella1


Cells(14, 48).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<QUI?????


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If

Sheets("Foglio21").Select 'vado al foglio Tabella1
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=47 'rimuovo i filtri
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=40 'rimuovo i filtri
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=40, Criteria1:= _
        "F" 'applico filtro Femmine
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=47, Criteria1:= _
        "=Nuovo_Iscritto_BRUCHINO", Operator:=xlOr, Criteria2:= _
        "=Nuovo_Iscritto_COCCINELLA" 'applico filtro Superpiccoli e piccoli
   
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella1[Inquadratura]:Tabella1[Colore Classe]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Range("Tabella1[Inquadratura]:Tabella1[Colore Classe]").Select
Selection.ClearContents 'cancello il range che incollerò in Griglia
End If

   
   

   
    Sheets("Foglio90").Select
    ActiveSheet.ListObjects("Tabella11").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
       
 On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella11[Inquadratura]:Tabella11[COLORE Classe]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Range("Tabella11[Inquadratura]:Tabella11[COLORE Classe]").Select
Selection.Copy 'copio il range che incollerò in Tabella
Sheets("Foglio21").Select 'vado al foglio Tabella1


Cells(10, 48).Select '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<QUI?????


Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
       
       
    Sheets("Foglio21").Select
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=47 'rimuovo il filtro attivato in preced
    ActiveSheet.ListObjects("Tabella1").Range.AutoFilter Field:=40 'rimuovo il filtro attivato in preced
    Range("AO2").Select
   
   
    Sheets("Foglio90").Select
    ActiveSheet.ListObjects("Tabella11").Range.AutoFilter Field:=1 'rimuovo filtro preced
    ActiveSheet.ListObjects("Tabella10").Range.AutoFilter Field:=1 'rimuovo filtro preced
    Range("B104:B203").ClearContents 'Pulisco il range delle 2 tabelle
    Range("B208:B307").ClearContents
    Range("G205").Select 'posizione finale in foglio90
   
   
    Sheets("Foglio8").Select
    Range("Tabella2[Colonna1]").ClearContents 'Pulisco il range delle 2 tabelle
    Range("Tabella4[Colonna1]").ClearContents
   
    Cells(16, 3).Select
End Sub

[Anthony47]

Non so che cosa vuoi fare, ma tieni presente che puoi copiare un intervallo non contiguo (es righe filtrate) solo in un intervallo contiguo; quindi se pensi di incollare i dati solo sulle righe visibili di Tabella1 sbagli (i dati saranno incollati dalla prima riga selezionata e sulle righe successive, che siano visibili o invisibili).
Cio' detto, se vuoi sapere quale e' il numero della prima riga visibile in Tabella1 dovresti poter usare una istruzione come questa:

Codice: Seleziona tutto

InitR = Range("Tabella1").SpecialCells(xlCellTypeVisible).Range("A1").Address


Il valore e' contenuto nella variabile InitR.

Ciao

[marte1503]

Ciao Antony,
grazie per la risposta e per l’avviso.

..Vero, quello che avevo pensato non si può fare con quel sistema.

Per aggirare l’ostacolo ho creato una copia identica di Tabella1 (Tabella113 in foglio 41) con l'intenzione di utilizzarla come Tabella provvisoria, poi una volta finito di inserire i nuovi iscritti copierò il range di Tabella113 e lo incollerò in Tabella1.


A questo punto però ho bisogno di modificare la macro che uso al momento per importare i dati in Tabella1
aggiungendo un comando:

SE foglio90 cella AH47 è uguale a Nuovo_Iscritto_BRUCHINO oppure Nuovo_Iscritto_COCCINELLA
i dati selezionati andranno incollati in Tabella113 altrimenti in Tabella1 con i criteri indicati dalla macro.

Questa la macro perfettamente funzionante per importare dati in Tabella1:

Codice: Seleziona tutto

'pulsante di attivazione in foglio 7
    If Cells(21, 7) <> "Salva i Dati" Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("Foglio21").Select
    ActiveSheet.Unprotect
    ActiveSheet.ListObjects("tabella1").Range.AutoFilter Field:=40 'rimuovo i filtri
    ActiveSheet.ListObjects("tabella1").Range.AutoFilter Field:=47
    ActiveSheet.ListObjects("tabella1").Range.AutoFilter Field:=48
    Range("Tabella1[Iniziale nome]").Select
    Selection.ListObject.ListRows.Add (1) 'aggiungo una riga
    Selection.ListObject.ListRows.Add (1) 'aggiungo una riga
    Sheets("Foglio90").Select
    Range("AH2:AH127").Select 'copio i dati che incollerò in tabella1
    Selection.Copy
    Sheets("Foglio21").Select
    Range("C4").Select 'seleziono la cella da cui verranno incollati i dati
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=True 'dati incollati con matrice trasposta
    Range("B5").Select 'seleziono la riga che andrò a eliminare
    Application.CutCopyMode = False
    Selection.ListObject.ListRows(2).Delete 'elimino la riga immediatamente sotto all'ultimo inserimento dati
   
    'con questa procedura ho aggiunto una riga di dati in testa a tabella1
   
    Range("B1:EX1").Select 'imposto il range finale(cella unita)
    Sheets("Foglio90").Select
    Range("AH1").Select 'imposto il range finale
   
   
   
    'pulisco i fogli interessati dai dati che vengono replicati in foglio 90
    'per poi essere copiati e incollati con matrice trasposta in tabella1
    Sheets("Foglio7").Select
    Range("D9:H18").ClearContents
    Range("D9").Select
   
    Sheets("Foglio6").Select
    ActiveSheet.Unprotect
    Range("G8").ClearContents
    Range("G10").ClearContents
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    Sheets("Foglio5").Select
    Range("F23:F32").ClearContents
    Range("F11:F20").ClearContents
    Range("F11").Select
   
    Sheets("Foglio4").Select
    Range("M17").ClearContents
    Range("M15").ClearContents
    Range("M13").ClearContents
   
    Sheets("Foglio3").Select
    ActiveSheet.Unprotect
    Range("D5:D53").ClearContents
    Range("D5").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
       
        'ordino alfabeticamente i dati inseriti in tabella1 con precedenza Nome poi Cognome
   ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort.SortFields. _
        Add Key:=Range("Tabella1[Nome Bambino]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort.SortFields. _
        Add Key:=Range("Tabella1[Cognome Bambino]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
       
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    'al termine della macro torno in foglio3 per effettuare nuovi inserimenti
    Sheets("Foglio3").Select
    Application.ScreenUpdating = True
    Range("A1").Select
    Cells(5, 4).Select
           
    End Sub

Si può fare?
Come devo procedere?

Grazie 1000 per il supporto
marte

[Anthony47]

Creati un flag, che posizioni a VERO o FALSO e con cui gestisci la scelta della tabella di destinazione.
Quindi, in testa alla macro

Codice: Seleziona tutto

If Sheets("Foglio90").Range("AH40")=" Nuovo_Iscritto_BRUCHINO" or _
Sheets("Foglio90").Range("AH40")=" Nuovo_Iscritto_COCCINELLA" then
TFlag=True
Ese TFlag=False
End if


Poi

Codice: Seleziona tutto

    Range("AH2:AH127").Select 'copio i dati che incollerò in tabella1
    Selection.Copy   'Esistenti
If TFlag then
Sheets("Foglio41").range("Tabella113").range("A1"). PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=True 'dati incollati con matrice trasposta
Else
Sheets("Foglio21").range("Tabella1").range("A1"). PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=True 'dati incollati con matrice trasposta
End if
'Seguono altre istruzioni


Quanto scritto e' solo uno spunto, perche' non mi sono chiarito dalla tua macro (che ho guardato solo velocemente) quali operazioni devi eseguire su tabella1 o tabella113.

Ciao

[marte1503]

Ciao Anthony,
solo oggi ho trovato l’occasione di lavorare alla macro…
Credo di aver inquadrato come si crea un flag.
Grazie 1000 per la spiegazione e l’esempio!
Soddisfatto per la riuscita posto la nuova macro funzionante:

Codice: Seleziona tutto

 'pulsante di attivazione in foglio 7
If Sheets("Foglio90").Range("AH47") = "Nuovo_Iscritto_BRUCHINO" Or _
Sheets("Foglio90").Range("AH47") = "Nuovo_Iscritto_COCCINELLA" Then
TFlag = True
Else: TFlag = False
End If


If TFlag Then
    If Cells(21, 7) <> "Salva i Dati" Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("Foglio41").Select
    ActiveSheet.Unprotect
    ActiveSheet.ListObjects("tabella115").Range.AutoFilter Field:=40 'rimuovo i filtri
    ActiveSheet.ListObjects("tabella115").Range.AutoFilter Field:=47
    ActiveSheet.ListObjects("tabella115").Range.AutoFilter Field:=48
    Range("Tabella115[Iniziale nome]").Select
    Selection.ListObject.ListRows.Add (1) 'aggiungo una riga
    Selection.ListObject.ListRows.Add (1) 'aggiungo una riga
    Sheets("Foglio90").Select
    Range("AH2:AH127").Select 'copio i dati che incollerò in tabella1
    Selection.Copy
    Sheets("Foglio41").Select
    Range("C4").Select 'seleziono la cella da cui verranno incollati i dati
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=True 'dati incollati con matrice trasposta
    Range("B5").Select 'seleziono la riga che andrò a eliminare
    Application.CutCopyMode = False
    Selection.ListObject.ListRows(2).Delete 'elimino la riga immediatamente sotto all'ultimo inserimento dati
       
           'ordino alfabeticamente i dati inseriti in tabella1 con precedenza Nome poi Cognome
    ActiveWorkbook.Worksheets("Foglio41").ListObjects("Tabella115").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Foglio41").ListObjects("Tabella115").Sort.SortFields. _
        Add Key:=Range("Tabella115[Nome Bambino]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Foglio41").ListObjects("Tabella115").Sort.SortFields. _
        Add Key:=Range("Tabella115[Cognome Bambino]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio41").ListObjects("Tabella115").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Range("B1:EX1").Select 'imposto il range finale(cella unita)
    Sheets("Foglio90").Select
    Range("AH1").Select 'imposto il range finale

Else
    If Cells(21, 7) <> "Salva i Dati" Then Exit Sub
    Application.ScreenUpdating = False
    Sheets("Foglio21").Select
    ActiveSheet.Unprotect
    ActiveSheet.ListObjects("tabella1").Range.AutoFilter Field:=40 'rimuovo i filtri
    ActiveSheet.ListObjects("tabella1").Range.AutoFilter Field:=47
    ActiveSheet.ListObjects("tabella1").Range.AutoFilter Field:=48
    Range("Tabella1[Iniziale nome]").Select
    Selection.ListObject.ListRows.Add (1) 'aggiungo una riga
    Selection.ListObject.ListRows.Add (1) 'aggiungo una riga
    Sheets("Foglio90").Select
    Range("AH2:AH127").Select 'copio i dati che incollerò in tabella1
    Selection.Copy
    Sheets("Foglio21").Select
    Range("C4").Select 'seleziono la cella da cui verranno incollati i dati
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=True, Transpose:=True 'dati incollati con matrice trasposta
    Range("B5").Select 'seleziono la riga che andrò a eliminare
    Application.CutCopyMode = False
    Selection.ListObject.ListRows(2).Delete 'elimino la riga immediatamente sotto all'ultimo inserimento dati
   
           'ordino alfabeticamente i dati inseriti in tabella1 con precedenza Nome poi Cognome
    ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort.SortFields. _
        Clear
    ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort.SortFields. _
        Add Key:=Range("Tabella1[Nome Bambino]"), SortOn:=xlSortOnValues, Order:= _
        xlAscending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort.SortFields. _
        Add Key:=Range("Tabella1[Cognome Bambino]"), SortOn:=xlSortOnValues, Order _
        :=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Foglio21").ListObjects("Tabella1").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
    Range("B1:EX1").Select 'imposto il range finale(cella unita)
    Sheets("Foglio90").Select
    Range("AH1").Select 'imposto il range finale
   
End If
   
   
    'pulisco i fogli interessati dai dati che vengono replicati in foglio 90
    'per poi essere copiati e incollati con matrice trasposta in tabella1
    Sheets("Foglio7").Select
    Range("D9:H18").ClearContents
    Range("D9").Select
   
    Sheets("Foglio6").Select
    ActiveSheet.Unprotect
    Range("G8").ClearContents
    Range("G10").ClearContents
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    Sheets("Foglio5").Select
    Range("F23:F32").ClearContents
    Range("F11:F20").ClearContents
    Range("F11").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    Sheets("Foglio4").Select
    Range("M17").ClearContents
    Range("M15").ClearContents
    Range("M13").ClearContents
   
    Sheets("Foglio3").Select
    ActiveSheet.Unprotect
    Range("D5:D53").ClearContents
    Range("D5").Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
       
 
   
    'al termine della macro torno in foglio3 per effettuare nuovi inserimenti
    Sheets("Foglio3").Select
    Application.ScreenUpdating = True
    Range("A1").Select
    Cells(5, 4).Select
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
   
    End Sub

Ciao e grazie ancora
marte

[marte1503]

Ciao a tutti.

Con il registratore ho creato una macro,
questo è il passaggio sul quale devo intervenire sostituendo il range impostato da me, con l’istruzione per rilevare in automatico l’ultima riga occupata di Tabella1

Codice: Seleziona tutto

Range("B25").Select  ‘<<<<<<<<<<<<<<<ultima riga di Tabella1

    Selection.ListObject.ListRows.Add AlwaysInsert:=True 'aggiungo riga ai piedi di Tabella1
    Range("B26").Select  'seleziono il punto di incollaggio per i nuovi dati

Grazie

[Anthony47]

Con questo codice aggiungi una riga sulla tabella e la selezioni per le operazioni successive:

Codice: Seleziona tutto

With ActiveSheet.ListObjects("Tabella1")
.ListRows.Add
.ListRows(.ListRows.Count).Range.Range("A1").Select
End With


Ciao

[marte1503]

Grazie Anthony,

ho aggiunto il comando. Pare funzionare ma sono alle prese con altri problemi...

Ora vado a letto non son più lucido..

Se dovessi avere nuovi problemi posto ancora.

Ciao
marte

[marte1503]

Ciao Anthony
Ho un problema con la nuova macro che sto realizzando.
In pratica, filtro 4 Tabelle(TabelleSorgente) e incollo i dati (speciale Valori) in una TabellaDestinazione.
Ho notato che tutto funziona bene se la TabellaDestinazione ha un numero di righe superiore a quelle che ottengo dalle 4 TabelleSorgente filtrate, se al contrario è inferiore la macro si interrompe e mi dà l’errore.
Nel mio caso, inizialmente la TabellaDestinazione ha una sola riga e avrei bisogno un comando per incrementare le righe quanto basta per ospitare i dati delle 4 TabelleSorgente.
Che istruzione mi serve per fare questa operazione?

Posto la Sub per maggiore chiarezza:

Codice: Seleziona tutto

Sub Inserisci_Iscritti_Luglio()

'
'Recupero gli iscritti selezionati con la X dai fogli Classe G-V-R-A
'
Sheets("Foglio15").Select

     Columns("C:C").Select
     ActiveSheet.Unprotect
    Selection.EntireColumn.Hidden = False
 ActiveSheet.ListObjects("Tabella4").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella4[Classe]:Tabella4[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Selection.Copy 'copio il range che incollerò in Tabella
Sheets("Foglio19").Select
Cells(6, 3).Select 'seleziono il punto dove andrò a incollare i valori copiati dalla prima tabella Sorgente selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio15").Select
Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
ActiveSheet.ListObjects("Tabella4").Range.AutoFilter Field:=1

   Sheets("Foglio19").Select
    With ActiveSheet.ListObjects("Tabella16")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

‘<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<fine primo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Sheets("Foglio16").Select
ActiveSheet.Unprotect
     Columns("C:C").Select
    Selection.EntireColumn.Hidden = False
 ActiveSheet.ListObjects("Tabella11").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella11[Classe]:Tabella11[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Selection.Copy 'copio il range che incollerò in Griglia
Sheets("Foglio19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio16").Select
Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
ActiveSheet.ListObjects("Tabella11").Range.AutoFilter Field:=1

  Sheets("Foglio19").Select
    With ActiveSheet.ListObjects("Tabella16")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

‘<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< fine secondo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Sheets("Foglio17").Select
ActiveSheet.Unprotect
     Columns("C:C").Select
    Selection.EntireColumn.Hidden = False
 ActiveSheet.ListObjects("Tabella12").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella12[Classe]:Tabella12[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Selection.Copy 'copio il range che incollerò in Griglia
Sheets("Foglio19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio17").Select
Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
ActiveSheet.ListObjects("Tabella12").Range.AutoFilter Field:=1

  Sheets("Foglio19").Select
    With ActiveSheet.ListObjects("Tabella16")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

‘<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<fine terzo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

Sheets("Foglio18").Select
ActiveSheet.Unprotect
     Columns("C:C").Select
    Selection.EntireColumn.Hidden = False
 ActiveSheet.ListObjects("Tabella13").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella13[Classe]:Tabella13[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Selection.Copy 'copio il range che incollerò in Griglia
Sheets("Foglio19").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio18").Select
Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
ActiveSheet.ListObjects("Tabella13").Range.AutoFilter Field:=1
‘<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<fine quarto step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

End Sub

Grazie
Marte

[Anthony47]

Evidentemente non ti consente di mettere 6 righe in un contenitore di 5 righe...
Il mio suggerimento e' che allunghi le tabelle target di un numero di righe pari alle righe filtrate; per questo ti do' una serie di semilavorati, da comporre.

1) Per conoscere quante righe di una tabella filtrata sono visibili:

Codice: Seleziona tutto

Sub ContaVis()
With Range("Tabella1").SpecialCells(xlCellTypeVisible)
    RigheVis = .Count / .Columns.Count     'RigheVis=N° righe visibili
End With
End Sub


2) Per contare quante righe son in una tabella (probabilmente non ti serve):

Codice: Seleziona tutto

Sub ContaAll()
With Range("Tabella1")
    RigheTab = .Count / .Columns.Count   'RigheTab=N° righe totali di tabella
End With
End Sub


3) Per aggiungere N linee a una tabella:

Codice: Seleziona tutto

Sub AddRighe()
NewLin = 1
Sheets("Foglio1").ListObjects("Tabella1").Resize _
    Range("Tabella1").Offset(-1, 0).Resize(Range("Tabella1").Rows.Count + NewLin + 1)
End Sub


(aggiunge il numero di linee indicate nella variabile NewLin)

Non mi cimento nell' inserire, con le dovute personalizzazioni, questi pezzi di codici nella tua macro; immagino che per te sia abbastanza semplice localizzare i punti di intervento.

Ciao

[marte1503]

Ciao Anthony,
sono riuscito!

Codice: Seleziona tutto

Application.ScreenUpdating = False
Sheets("Foglio15").Select
     Columns("C:C").Select
     ActiveSheet.Unprotect
    Selection.EntireColumn.Hidden = False
 ActiveSheet.ListObjects("Tabella4").Range.AutoFilter Field:=1, Criteria1:= _
        "<>"
    On Error Resume Next
Set myFiltr = Nothing
Set myFiltr = Range("Tabella4[Classe]:Tabella4[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Not myFiltr Is Nothing Then
myFiltr.Select
Selection.Copy 'copio il range che incollerò in Tabella

NewLin = Sheets("Foglio15").Cells(2, 26)'<<<<<<<<<<Riferimento  a cella appoggio che ricava n°righe occupate
Sheets("Foglio19").ListObjects("Tabella16").Resize _
Range("Tabella16").Offset(-1, 0).Resize(Range("Tabella16").Rows.Count + NewLin + 1)


Sheets("Foglio19").Select
Cells(6, 3).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
Sheets("Foglio15").Select
Columns("C:C").Select
    Selection.EntireColumn.Hidden = True
ActiveSheet.ListObjects("Tabella4").Range.AutoFilter Field:=1
 ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<Primo step>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

   Sheets("Foglio19").Select
   ActiveSheet.Unprotect
    With ActiveSheet.ListObjects("Tabella16")
   .ListRows.Add
  .ListRows(.ListRows.Count).Range.Range("A1").Select
   End With

'<<<<<<<<<<<<<<<Aggiungo riga in foglio19>>>>>>>>>>>>>>>
Eccetera Eccetera........


Delle 3 soluzioni che mi hai dato ho scelto la terza
Appena l’ho letta sono rimasto in dubbio non sapendo se in excel (come sembrava di capire dalla tua risposta) le parole “ linee” e “righe” fossero sinonimi; provando ho dedotto che lo sono.

Per ricavare il numero delle righe da definire nella variabile NewLin ho pensato di inserire in una Cella appoggio vicino alle 4 TabelleSorgente una formula CONTA.SE , Cella che poi ho richiamato nel passaggio NewLin.
Ora la macro mi importa tutti i dati necessari nella Tabella Destinazione.
A questo punto, per eliminare le righe vuote che mi aggiunge la funzione ListRows.Add ho pensato di usare un espediente già utilizzato in altra macro: ordino la tabella; le righe bianche vanno in coda, poi vengono eliminate con il listato

Codice: Seleziona tutto

On Error Resume Next
    Sheets("Foglio19").Select
    UR = Range("D" & Rows.Count).End(xlUp).Row
If UR < 6 Then UR = 6
    Range("C6:D" & UR).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    Range("A1").Select
    On Error GoTo 0

Tutti passaggi che probabilmente ti faranno inorridire, ma visto il mio livello di conoscenza mi accontento del semplice funzionamento, le finezze spero di raggiungerle perseverando…


Per ora come al solito ti ringrazio per l’aiuto.
A risentirci…
Marte

[Anthony47]

In realta' sarebbe stato (forse) piu' semplice se avessi usato anche la Sub ContaVis per calcolare quante righe son da aggiungere. Nel tuo contesto:

Codice: Seleziona tutto

Set myFiltr = Range("Tabella4[Classe]:Tabella4[Delegati al ritiro 3]").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
'AGGIUNTE:
With Range("Tabella4").SpecialCells(xlCellTypeVisible)    'probabilmente e' ok anche con With MyFiltr
    NewLin = .Count / .Columns.Count     'RigheVis=N° righe visibili
End With
'==fine aggiunte; la variabile NewLin contiene il n° di righe visibili che saranno copiate
If Not myFiltr Is Nothing Then   'Esistente
'etc etc


In questo modo non hai bisogno della cella con formula di appoggio sul foglio e del suo richiamo con l' istruzione NewLin = Sheets("Foglio15").Cells(2, 26) (che quindi deve essere eliminata), e probabilmente non avresti nemmeno il problema di eliminare righe aggiunte in eccesso.

Comunque se funziona e' ottimo cosi'.

Ciao