Raggruppare i fogli

Buongiorno Vorrei sapere se c'è un metodo o una macro che permette di raggruppare i fogli. Mi spiego ho creato un file di excel con circa 20 fogli (ogni foglio è un dipedente) devo raggrupparli per reparto di appartenenza  

le macro non sono già pronte, vengono costruite, allega un file di esempio con i dati ed un abbozzo di risultato desiderato

Allego un file di prova
Nel file ci sono i fogli di cui ogniuno con un nome (lettera) e con colori diversi, lo stesso colore fa parte dello stesso reparto.
Vorrei racchiudere tutti i fogli con lo stesso colore e successivamente creare una macro che apre solo il reparto con tutti i fogli corrispondenti.
grazie

enricoruggeri., 25/07/2016 15.30:

---

.....Vorrei racchiudere tutti i fogli con lo stesso colore e successivamente creare una macro che apre solo il reparto con tutti i fogli corrispondenti.
grazie

---

Ciao
che significa "racchiudere"?

Vorresti nascondere tutti i fogli e scoprire solo quelli rossi per esempio?

saluti

Se è possibile creare una cartella in excel con i fogli rossi una con i fogli arancio e cosi via. Se questo non fosse possibile creare delle macro azionate da un bottone che visualizza solo i fogli rossi o arancio o verdi

Ciao
da quello che ho capito, vuoi creare (dal tuo esempio) 4 file con ciascuno all'interno x fogli dello stesso colore, quindi un file con tutti i fogli rossi, uno con tutti i fogli verdi ecc..ecc.

NOTA: crea una cartella in c e chiamala MiaCartella (oppure correggi il percorso nella macro dove salvare i file creati).
Tieni presente che ogni volta che esegui la macro, i file precedenti verranno sovrascritti, in virtù dell'istruzione:
Application.DisplayAlerts = False.

Fogli di colore diverso intrerrompono l'esecuzione.


Saluti

Sub SalvaFogli()
Dim mPath As String, NewWbk As Workbook, mName As String
Dim rArr(), vArr(), bArr(), gArr()
ReDim rArr(0)
ReDim vArr(0)
ReDim bArr(0)
ReDim gArr(0)

mPath = "C:\MiaCartella"
rosso = 192
verde = 5287936
blu = 13998939
giallo = 49407

For i = 1 To Sheets.Count
    Select Case Sheets(i).Tab.Color
        Case Is = rosso
            rArr(r) = Sheets(i).Name
            r = r + 1
            ReDim Preserve rArr(r)
        Case Is = verde
            vArr(v) = Sheets(i).Name
            v = v + 1
            ReDim Preserve vArr(v)
        Case Is = blu
            bArr(b) = Sheets(i).Name
            b = b + 1
            ReDim Preserve bArr(b)
        Case Is = giallo
            gArr(g) = Sheets(i).Name
            g = g + 1
            ReDim Preserve gArr(g)
        Case Else
            MsgBox "Sono presenti fogli con colori non previsti." & _
                    "Elaborazione interrotta"
            Exit Sub
    End Select
Next
ReDim Preserve rArr(LBound(rArr) To UBound(rArr) - 1)
ReDim Preserve vArr(LBound(vArr) To UBound(vArr) - 1)
ReDim Preserve bArr(LBound(bArr) To UBound(bArr) - 1)
ReDim Preserve gArr(LBound(gArr) To UBound(gArr) - 1)

Application.DisplayAlerts = False
Application.ScreenUpdating = False

Sheets(rArr).Copy
ActiveWorkbook.SaveAs Filename:=mPath & "\" & "Rosso"
ActiveWorkbook.Close

Sheets(vArr).Copy
ActiveWorkbook.SaveAs Filename:=mPath & "\" & "Verde"
ActiveWorkbook.Close

Sheets(bArr).Copy
ActiveWorkbook.SaveAs Filename:=mPath & "\" & "Blu"
ActiveWorkbook.Close
   
Sheets(gArr).Copy
ActiveWorkbook.SaveAs Filename:=mPath & "\" & "Giallo"
ActiveWorkbook.Close
   
Application.DisplayAlerts = True
Application.ScreenUpdating = True
Application.CutCopyMode = False
End Sub

 

Chiedo scusa ma ho problemi con i tag code. Prego gli amministratori di modificare. grazie