Risolto suddividere i dati contenuti in un foglio dopo aver creato n fogli ad ogni cambio di una determinata cella.

[ezio68]

Mi fa piacere che hai dato uno sguardo anche alla mia soluzione

E perché non avrei dovuto ? Sarebbe stata solo questione di tempo. Sto cercando di rallentare altrimenti non riesco ad assimilare i vostri suggerimenti. Grazie

 

[Alexps81]

con qualche piccola modifica sono riuscito ad adattarlo alle mie necessità

Bene, sono contento. Ovviamente non conoscendo esattamente la struttura del file originale me ne vado per un'idea e ti consiglierei queste migliorie:

Hai giustamente agito sui limiti dell'array dati in base al numero di colonne della tabella che nel mio esempio vanno da 1 a 3 mentre tu hai scritto da 1 a 24 (presumo che la tua tabella abbia 24 colonne).

ReDim dati(1 To 24) As Variant

A questo punto anziché imporre come numero massimo 24, potresti ricavarlo automaticamente. Così la macro si adatterà in base alla larghezza della Tabella e non dovrai più preoccuparti di modoficare i limiti manualmente qualora qualcosa cambi nel tempo:

ReDim dati(1 To tbl.ListColumns.Count)

L'intestazione di riga di ogni foglio la definisci anche qui in modo del tutto manuale (via codice):

.Range("A1:x1").Value = Array("Codice Ambito", "Provincia", "Regione", "Tipo Prescrizione", "Codice Fiscale", _
                "Numero Documento", "Tipo Spedizione", "Descrizione Tipo Spedizione", "XIDEFIL", "XIDETIA", "Data Creazione TIA", _
                "Id PCS", "Debito", "Codice Esito", "Descrizione Codice Esito", "Esito_descrizione", "Codice Esito PT", _
                "Descrizione Codice Esito PT", "Codice Sotto Motivo", "Descrizione Codice Sotto Motivo", "Data Evento", _
                "Modalità di Notifica", "Descrizione Modalità di Notifica", "Prescrizione Reale (COVID)")

Ma se la tua intenzione fosse quella di riportare le stesse etichette della Tabella, allora potresti prelevarle direttamente così:

.Range("A1").Resize(1, tbl.ListColumns.Count).Value = tbl.HeaderRowRange.Value

la ciliegina sulla torta : l'ultimo campo non ha la necessità di avere lo stesso valore contiguo !

Onestamente questa non l'ho capita. Forse vuoi escludere qualche colonna?

Adesso c'è un problema : cercare di capire cosa hai fatto

Il codice l'ho commentato riga per riga, spero si capisca ciò che ho scritto. Ad ogni modo la chiave di tutto il codice è l'utilizzo di Dictionary e Collection. Sono simili ma in base al tipo di impiego si decide se usare l'una o l'altra o addirittura entrambe come in questo caso, che hanno reso possibile il risultato voluto.
Purtroppo volendo tradurlo in un linguaggio comprensibile non è proprio una passeggiata
Però dato che sei in periodo diciamo didattico, penso sia una buona occasione per imparare le Dictionary e le Collection in modo che tu posso capire da solo cosa avviene in questo codice

 

[ezio68]

Però dato che sei in periodo diciamo didattico, penso sia una buona occasione per imparare le Dictionary e le Collection in modo che tu posso capire da solo cosa avviene in questo codice

salve, ho applicato i tuoi suggerimenti e adesso è tutto più "dinamico" :

Private Sub CommandButton5_Click()

    Dim tbl As ListObject
    Dim ws As Worksheet, sh As Worksheet
    Dim dict As Object
    Dim coll As Collection
    Dim Trimestre As String
    Dim cella As Range
    Dim dati() As Variant, chiave As Variant, elemento As Variant
    Dim ur As Long, i As Long
    
    Set ws = ThisWorkbook.Worksheets("elenco") '<-imposto il foglio
    Set tbl = ws.ListObjects(1) '<-imposto la tabella
    Set dict = CreateObject("Scripting.Dictionary") '<-imposto un dizionario
        
    Application.ScreenUpdating = False
    
    For Each cella In tbl.ListColumns("Prescrizione Reale (COVID)").DataBodyRange '<-scorro ogni cella della colonna denominata "Regione" della tabella
        Trimestre = UCase(Trim(cella.Value)) '<-memorizzo il suo valore in una variabile di tipo stringa (converto in maiuscolo e tolgo gli spazi all'inizio e alla fine)
        
        ReDim dati(1 To tbl.ListColumns.Count) As Variant '<-dimensiono "manualmente" l'array "dati" che conterrà i valori delle colonna "A" e "C"

        'attenzione...di seguito c'è un piccolo ciclo For/Next per caricare i valori di colonna "A", "B" e "C" in un array. _
        Il ciclo si puo' estendere tranquillamente per quante colonne occorre, basta agire sui numeri 1 e 3 (partenza e fine). _
        Sarebbe anche possibile e consigliato, ricavare il tutto in automatico, calcolando la dimensione della tabella in base al numero di colonne, _
        in modo da ridimensionare l'array "dati"
        For i = 1 To UBound(dati)
            dati(i) = ws.Cells(cella.Row, i).Value
        Next i

        'creo e carico i dati nel dizionario
        If Not dict.Exists(Trimestre) Then '<-se non esiste un dizionario con il nome della regione allora...
            Set coll = New Collection '<-imposto una nuova collezione
            coll.Add dati '<-carico l'array "dati" nella nuova collezione
            dict.Add Trimestre, coll '<-aggiungo al dizionario della regione, la collezione (ovvero i dati di colonna "A" e "B" in questo caso)
        Else
            'se invece il dizionario di quella regione già esiste, allora...
            dict(Trimestre).Add dati '<-aggiungo i nuovi "dati" a quel dizionario
        End If
    Next cella
    
    'se è stato creato un dizionario...
    If dict.Count > 0 Then
        For Each chiave In dict.Keys '<-per ogni chiave del dizionario...
            Set sh = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count)) '<-creo un nuovo foglio
            With sh
                
                .Range("A1").Resize(1, tbl.ListColumns.Count).Value = tbl.HeaderRowRange.Value
                
                .Name = chiave '<-lo rinomino con il nome della chiave (nome della Regione)

                ' HO COMMENTATO L'ARRAY
                '.Range("A1:x1").Value = Array("Codice Ambito", "Provincia", "Regione", "Tipo Prescrizione", "Codice Fiscale", _
                '"Numero Documento", "Tipo Spedizione", "Descrizione Tipo Spedizione", "XIDEFIL", "XIDETIA", "Data Creazione TIA", _
                '"Id PCS", "Debito", "Codice Esito", "Descrizione Codice Esito", "Esito_descrizione", "Codice Esito PT", _
                '"Descrizione Codice Esito PT", "Codice Sotto Motivo", "Descrizione Codice Sotto Motivo", "Data Evento", _
                '"Modalità di Notifica", "Descrizione Modalità di Notifica", "Prescrizione Reale (COVID)")
                '<-creo una piccola intestazione in riga 1
                
                'adesso, per ogni elemento presente in quella chiave (regione)...
                For Each elemento In dict(chiave)
                    ur = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 '<-calcolo la prima riga utile per poter scrivere gli elementi
                    'scrivo su foglio creato tutti gli elementi.
                    .Cells(ur, 1).Resize(1, UBound(elemento)).Value = Application.Transpose(Application.Transpose(elemento))
                Next elemento
    
                .Cells.Columns.AutoFit '<-adatto le colonne al contenuto del testo scritto.
            End With
        Next chiave
    End If
    
    Application.ScreenUpdating = True


End Sub

Adesso ho un bel pò di "carne al fuoco" . . . Che dirvi ? semplicemente grazie a tutti per l'enorme pazienza !