Ho elaborato questo codice:
- Codice: Seleziona tutto
Dim Sedi() As String
Option Explicit
Sub WFSede()
Dim CSede As Long, DBase As String, ColNomi As String, mySede As Range
Dim cWeek As Long, myName As String, LastR As Long, Weeks As String, I As Long
'
ReDim Sedi(1 To 100)
DBase = "base DATI" '<<< Il foglio col data base
ColNomi = "F" '<<< La colonna con i nominativi
'
Sheets(DBase).Select
LastR = Cells(Rows.Count, ColNomi).End(xlUp).Row
Weeks = Range(Cells(1, ColNomi).Offset(0, 2), Cells(1, ColNomi).End(xlToRight)).Address
For Each mySede In Range(Weeks).Offset(1, 0).Resize(LastR - 1)
If mySede.Value <> "" Then
If newSede(mySede) Then
On Error Resume Next
Sheets(mySede.Value).Select
On Error GoTo 0
If ActiveSheet.Name <> mySede.Value Then
Sheets.Add after:=Sheets(ThisWorkbook.Worksheets.Count)
ActiveSheet.Name = mySede.Value
End If
Sheets(mySede.Value).Cells.Clear
Range("A2").Resize(Range(Weeks).Count, 1) = Application.WorksheetFunction.Transpose(Sheets(DBase).Range(Weeks).Value)
CSede = CSede + 1
Sedi(CSede) = mySede.Value
End If
Sheets(mySede.Value).Select
With Sheets(DBase)
cWeek = .Cells(1, mySede.Column): myName = .Cells(mySede.Row, ColNomi).Value & " " & .Cells(mySede.Row, ColNomi).Offset(0, 1).Value
Cells(Application.Match(cWeek, Range("A1:A1000"), 0), Columns.Count).End(xlToLeft).Offset(0, 1) = myName
End With
End If
Next mySede
For I = 1 To UBound(Sedi, 1)
If Sedi(I) <> "" Then
Sheets(Sedi(I)).Cells.EntireColumn.AutoFit
End If
Next I
End Sub
Function newSede(ByVal WSede As String) As Boolean
Dim pippo
pippo = Application.Match(WSede, Sedi, 0)
If IsError(pippo) Then newSede = True Else newSede = False
End Function
Da excel premi Alt-F11 per aprire l' editor delle macro; Menu /Inserisci /Modulo; copi il codice e incolli nel frame vuoto di dx.
Controlla le due istruzioni marcate <<< (le ho impostate secondo il modello che hai pubblicato, eventualmente aggiusta), poi esegui la macro WFSede:
-da excel, Alt-F8; scegli WFSede dall' elenco che ti propone, premi Esegui.
Oppure puoi disegnare un pulsante e associarci questa macro, in modo che bastera' premere il pulsante per avviare la macro.
La macro crea tanti fogli quante sono le "sedi" in elenco, e su questi fogli (che vengono inizialmente azzerati SENZA NESSUN PREAVVISO) si crea l' elenco desiderato.
Non mi sono applicato nella formattazione del risultato, quello e' solo un gioco di pazienza che puoi realizzare con una macro autoregistrata.
Prova e fai sapere, ciao
Registrazione
