salve
senza riscrivere tutta la macro, guarda se intanto il risultato va bene:

Option Base 1
Public Cl As Variant
Public sequenza As Long
Public myrow As Long
Public crit As Variant
Sub TabellaTabelle()
Dim ctr As Boolean, ctr2 As Boolean
With Sheets("foglio2")
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlNone
End With
sequenza = CLng(InputBox("SEQUENZA", "Dichiara limite sequenza"))
conta = 0
uriga = Range("A" & Rows.Count).End(xlUp).Row
For I = 8 To 33
Set Area = Range(Cells(3, I), Cells(uriga, I)).SpecialCells(xlCellTypeVisible)
If Area.Cells.Count > sequenza Then
If Sheets("foglio1").AutoFilterMode Then
With Sheets("Foglio1").AutoFilter.Filters(I)
If .On Then
crit = Area.Cells(1).Row
Colfil = Area.Cells(1).Column
End If
End With
Else: Exit Sub
End If
For Each Cl In Area
If Cl.Interior.ColorIndex = xlNone Then
conta = conta + 1
If Not ctr2 Then
myrow = Cl.Row
End If
ctr2 = True
Else
If conta = sequenza Then
Call copiaDati
ctr = True
conta = 0
End If
conta = 0
End If
Next
End If
conta = 0
ctr2 = False
Next
If ctr Then
With Sheets("foglio2").Cells(crit, Colfil).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
End If
End Sub

Sub copiaDati()
colonna = Cl.Column
With Sheets("foglio2")
With .Cells(myrow, colonna).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = 3
End With
End With
End Sub


Ora per l'applicazione dei filtri mi devi dire dove andare a pescare i criteri per ogni colonna della tabella 2

saluti
Giap

---

salve
premesso che nelle macro che ti ho inviato, c'è un errore nell'indicazione di un interruttore che ti correggerò,
il filtro applicato a tutte le colonne della tabella 2 per ogni valore presente in ciascuna colonna rappresenterà un peso enorme di elaborazione.
Scrivere la macro non è un problema non saprei quanto tempo impiegherà per l'elaborazione visto che tu hai tabelle macroscopiche.
saluti
Giap

---

salve
questa precisazione tra parentesi, potrebbe essere quello che vanifica tutto il lavoro.

guarda l'immagine qui sotto.
La tabella è filtrata per il codice 57 in colonna AC per cataste lunghe 6
le mie macro prelevano il valore 61 di colonna Z
è corretta l'interpetazione o è miservolmente sbagliata??



PS.
perchè la strada non è semplice come quella che ipotizzi?? considera che la sola colonna H contiene 92 record univoci, quindi per la sola colonna H bisogna applicare 92 filtri ipotizzando che tutte le altre colonne abbiano altrettanti records univoci moltiplica 92 x 26 colonne e ti portano ad un totale di 2496 filtri su ciascun filtro
vengono eseguti almeno 3 cicli

saluti
Giap

---

salve
quelle che seguono, sono le macro applicate sul file Aetio-prova-iv.xls
La macro principale alla quale sono legate tutte le altre è: filtrasequenza()

Option Base 1
Public Cl As Variant
Public sequenza As Long
Public myrow As Long
Public crit As Variant
Public urig As Long
Public colore As Long


Sub filtrasequenza()
Sheets("foglio1").Select
Application.ScreenUpdating = False
urig = Range("A" & Rows.Count).End(xlUp).Row
With Sheets("foglio2")
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlNone
End With
sequenza = CLng(InputBox("SEQUENZA", "Dichiara limite sequenza"))
If Sheets("foglio1").AutoFilterMode Then
Selection.AutoFilter
End If
Range("A1").AutoFilter
colore = 6
For n = 8 To 33
Set miaColl = New Collection
Set AreaCol = Range(Cells(3, n), Cells(urig, n))
For Each Clx In AreaCol
On Error Resume Next
miaColl.Add Clx, CStr(Clx)
On Error GoTo 0
Next
For y = 1 To miaColl.Count
Selection.AutoFilter Field:=n, Criteria1:=miaColl(y)
Call TabellaTabelle
Next y
Selection.AutoFilter Field:=n
Set miaColl = Nothing
Set AreaCol = Nothing
Next n
Application.ScreenUpdating = True
End Sub

Sub TabellaTabelle()
Dim ctr As Boolean, ctr2 As Boolean
Dim miaColl As Collection
conta = 0
For i = 8 To 33
Set Area = Range(Cells(3, i), Cells(urig, i)).SpecialCells(xlCellTypeVisible)
If Area.Cells.Count > sequenza Then
If Sheets("foglio1").AutoFilterMode Then
With Sheets("Foglio1").AutoFilter.Filters(i)
If .On Then
crit = Area.Cells(1).Row
Colfil = Area.Cells(1).Column
End If
End With
Else: Exit Sub
End If
For Each Cl In Area
If Cl.Interior.ColorIndex = xlNone Then
conta = conta + 1
If Not ctr2 Then
myrow = Cl.Row
End If
ctr2 = True
Else
If conta = sequenza Then
Call copiaDati
ctr = True
ctr2 = False
conta = 0
End If
conta = 0
ctr2 = False
End If
Next
End If
conta = 0
ctr2 = False
Next
If ctr Then
With Sheets("foglio2").Cells(crit, Colfil).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
colore = colore + 1
End With
End If
End Sub

Sub copiaDati()
colonna = Cl.Column
With Sheets("foglio2")
With .Cells(myrow, colonna).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
End With
End With
End Sub



prova e fa sapere.
saluti
Giap

---

In volo

Lascia lente le briglie del tuo ippogrifo, o a10n11, e sfrena il tuo volo dove più ferve l'opera dell'uomo.
Però non ingannarmi con false immagini ma lascia che io veda la verità e possa poi toccare il giusto.
Da qui, aetio, si domina la valle; ciò che si vede, è.
Ma se l'imago è scarna al nostro occhio scendiamo a rimirarla da più in basso e planeremo in un galoppo alato
entro il cratere ove gorgoglia il tempo.



...già nel 1972 il "Banco del Mutuo Soccorso" aveva presagio dei futuri accadimenti.

salve
ho potuto solo ora verificare la macro.
Ho individuato un errore che si verifica in una particolare circostanza (catasta che finisce nell'ultima cella della tabella) domani con calma faccio la correzione.
saluti
Giap

---

Ciao,

Caro Amico mio, nessunissima fretta... Grazie infinite per tutto quello che stai facendo per me.
Buona serata
eZio

salve
con un po' di ritardo ti posto le modifiche effettuate nelle macro.
ad un sommario controllo pare che vada prova tu in maniera più approfondita.
saluti
Giap

Public Cl As Variant
Public sequenza As Long
Public myrow As Long
Public crit As Variant
Public urig As Long
Public colore As Long
Public colfil As Long


Sub filtrasequenza()
Sheets("foglio1").Select
Application.ScreenUpdating = False
If Sheets("foglio1").AutoFilterMode Then
Selection.AutoFilter
End If
Range("A1").AutoFilter
urig = Range("A" & Rows.Count).End(xlUp).Row
With Sheets("foglio2")
.Cells.Interior.ColorIndex = xlNone
.Cells.Borders.LineStyle = xlNone
End With
sequenza = CLng(InputBox("SEQUENZA", "Dichiara limite sequenza"))
colore = 7
For n = 8 To 33
Set miaColl = New Collection
Set AreaCol = Range(Cells(3, n), Cells(urig, n))
For Each Clx In AreaCol
On Error Resume Next
miaColl.Add Clx, CStr(Clx)
On Error GoTo 0
Next
For y = 1 To miaColl.Count
Selection.AutoFilter Field:=n, Criteria1:=miaColl(y)
With Sheets("Foglio1").AutoFilter.Filters(n)
If .On Then
crit = Range(Cells(3, n), Cells(urig, n)).SpecialCells(xlCellTypeVisible).Cells(1).Row
colfil = n
End If
End With
Call TabellaTabelle
Next y
Selection.AutoFilter Field:=n
Set miaColl = Nothing
Set AreaCol = Nothing
Next n
Application.ScreenUpdating = True
End Sub

Sub TabellaTabelle()
Dim ctr As Boolean, ctr2 As Boolean, CtrlCol As Boolean
Dim miaColl As Collection
conta = 0
For i = 8 To 33
Set area = Range(Cells(3, i), Cells(urig, i)).SpecialCells(xlCellTypeVisible)
Lastfilt = Cells(Cells.Rows.Count, i).End(xlUp).Row
If area.Cells.Count < sequenza Then Exit For
For Each Cl In area
If Cl.Interior.ColorIndex = xlNone Then
conta = conta + 1
If Not ctr2 Then
myrow = Cl.Row
End If
ctr2 = True
If Cl.Row = Lastfilt Then GoTo dopo
Else
dopo:
If conta = sequenza Then
CtrCol = True
Call copiaDati
With Sheets("foglio2").Cells(crit, colfil).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
End With
Else
End If
conta = 0
ctr2 = False
End If
Next
conta = 0
ctr2 = False
Set area = Nothing
Next
If CtrCol Then
colore = colore + 1
End If
CtrCol = False
End Sub

Sub copiaDati()
colonna = Cl.Column
With Sheets("foglio2")
With .Cells(myrow, colonna).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
End With
End With
End Sub

---

salve
l'errore che indichi presume che ti dica che hai superato il limite dei colori disponibili (in Excel sono 56) almeno fino alla mia versione.
ho solo paura di pensare quanto è corposa la tua tabella.
l'unica soluzione che mi viene in mente è quella di reinizializzare la variabile colore quando arriva a 56, oppure mettere un colore fisso.
L'immagine qui sotto è il risultato (parziale) dell'elaborazione del file di prova con "catasta" 6



saluti
Giap

---

salve
per impostare un solo colore (es. rosso) modifica la macro TabellaTabelle() come segue

Sub TabellaTabelle()
Dim ctr As Boolean, ctr2 As Boolean
Dim miaColl As Collection
conta = 0
For i = 8 To 33
Set area = Range(Cells(3, i), Cells(urig, i)).SpecialCells(xlCellTypeVisible)
Lastfilt = Cells(Cells.Rows.Count, i).End(xlUp).Row
If area.Cells.Count < sequenza Then Exit For
For Each Cl In area
If Cl.Interior.ColorIndex = xlNone Then
conta = conta + 1
If Not ctr2 Then
myrow = Cl.Row
End If
ctr2 = True
If Cl.Row = Lastfilt Then GoTo dopo
Else
dopo:
If conta = sequenza Then
Call copiaDati
With Sheets("foglio2").Cells(crit, colfil).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = colore
End With
Else
End If
conta = 0
ctr2 = False
End If
Next
conta = 0
ctr2 = False
Set area = Nothing
Next
End Sub



non lo vedi perchè l'immagine è parziale. (Con filtro 6 in colonna P criterio di filtro 6), la "catasta" inizia in cella U48 con il codice 45 quindi al di fuori dell'immagine.
saluti
Giap

---