Moderatori: Anthony47, Flash30005
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
' 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
'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
InitR = Range("Tabella1").SpecialCells(xlCellTypeVisible).Range("A1").Address
'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
If Sheets("Foglio90").Range("AH40")=" Nuovo_Iscritto_BRUCHINO" or _
Sheets("Foglio90").Range("AH40")=" Nuovo_Iscritto_COCCINELLA" then
TFlag=True
Ese TFlag=False
End if
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
'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
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
With ActiveSheet.ListObjects("Tabella1")
.ListRows.Add
.ListRows(.ListRows.Count).Range.Range("A1").Select
End With
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
Sub ContaVis()
With Range("Tabella1").SpecialCells(xlCellTypeVisible)
RigheVis = .Count / .Columns.Count 'RigheVis=N° righe visibili
End With
End Sub
Sub ContaAll()
With Range("Tabella1")
RigheTab = .Count / .Columns.Count 'RigheTab=N° righe totali di tabella
End With
End Sub
Sub AddRighe()
NewLin = 1
Sheets("Foglio1").ListObjects("Tabella1").Resize _
Range("Tabella1").Offset(-1, 0).Resize(Range("Tabella1").Rows.Count + NewLin + 1)
End Sub
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........
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
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
Torna a Applicazioni Office Windows
problema ricezione notifiche outlook Autore: gianscooby |
Forum: Sistemi Operativi Windows Risposte: 2 |
Inserire add.in nella barra di avvio veloce in excel 2003 Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 4 |
Aggiornare cella con somma quando aggiungo nuova colonna Autore: marcopont |
Forum: Applicazioni Office Windows Risposte: 1 |
Excel: problema con date se devo unirle a testi Autore: valle1975 |
Forum: Applicazioni Office Windows Risposte: 5 |
Visitano il forum: Nessuno e 26 ospiti