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