Rieccomi…
E’ corretto che su Foglio2 ogni gruppo di schede in orizzontale e’ una squadra?
Ti propongo quindi la seguente soluzione.
Su foglio1 inserisci due celle con convalida, una per selezionare la squadra e una per selezionare l’ atleta della squadra.
Nel mio schema ho inserito queste celle in B5 (scegli squadra) e in D5 (scegli atleta).
Per B5 userai la Convalida Elenco, e come origine segnarai
- Codice: Seleziona tutto
=Squadre
Per D5 userai sempre Elenco, e come origine segnarai
- Codice: Seleziona tutto
=indiretto(B5)
Potrai pero’ inserire la convalida solo dopo aver eseguito la macro di inventario.
Sempre si foglio1 inseriamo 2 celle di servizio, che io ho messo in AT1 e AU1, con le formule
AT1
- Codice: Seleziona tutto
=CERCA.VERT(B5;SCARTO(Squadre;0;0;30;2);2;0)
AU1
- Codice: Seleziona tutto
=CONFRONTA(D5;INDIRETTO(B5);0)
Queste celle servono per puntare alla scheda su Foglio2; inoltre AU1 puo’ servire per la formattazione condizionale di D5, con la condizione “la formula è”, la formula =VAL.ERRORE($AU$1) e come formato un “Motivo” (sfondo cella) rosso. Il rosso serve per evidenziare che bisogna completare il ciclo di selezione squada /Atleta. Magari su D5 aggiungi un secondo livello di formattazione condizionale con “motivo” arancione, con la condizione “il valore della cella è” e negli spazi accanto “diverso da” e =P5 Questo indica che la scheda e’ ancora da aggiornare.
Poi ho costruito 2 macro.
La prima fa l’ inventario delle schede disponibili, delle squadre, la loro posizione sul foglio, gli atleti per singola squadra.
Il codice:
- Codice: Seleziona tutto
Sub invent()
' DEFINIZIONI
SkRoot = "C1" '<< "radice" delle schede
SkAdr = "A1:AI18" '<< Dimensione della scheda
SkPerRow = 5 '<< N° di schede per riga
TeamCol = 1 '<< Colonna in cui si trova il NOME SQUADRA; 1=A, 2=B, etc
SkCols = Range(SkAdr).Columns.Count
SkRows = Range(SkAdr).Rows.Count
Sheets("Foglio2").Select
Set SubRange = Application.Intersect(Range(ActiveSheet.UsedRange.Address), Range("c1:FU1000"))
'Calcolo dell' area in cui si fara' l' elenco e composizione Squadre
TeamList = Cells(1, SkPerRow * SkCols + 10).Address
Range(TeamList).Select
'Verifica se si puo' azzerare
Rispo = MsgBox("Posso cancellare l' elenco e la composizione delle Squadre?", vbYesNo)
If Rispo = vbNo Then GoTo Niente
Range(TeamList).Range("A1:Z30").ClearContents
'Calcola il nuovo elenco / composizione Squadre
For J = 0 To 30 'Max 30 Squadre
Range(SkRoot).Offset(J * SkRows, I * SkCols).Select
If ActiveCell.Value = "" Then Exit For
CTeam = Cells(ActiveCell.Row, TeamCol).Value 'Squadra corrente
Cells(ActiveCell.Row, TeamCol).Copy _
Destination:=Range(TeamList).Offset(100, 0).End(xlUp).Offset(1, 0)
Range(TeamList).Offset(100, 0).End(xlUp).Offset(0, 1).Value = ActiveCell.Address
For I = 0 To SkPerRow - 1
Range(SkRoot).Offset(J * SkRows, I * SkCols).Select
ActiveCell.Offset(0, 1).Copy _
Destination:=Range(TeamList).Offset(100, J + 2).End(xlUp).Offset(1, 0)
Next I
Range(Range(TeamList).Offset(1, J + 2), Range(TeamList).Offset(100, J + 2).End(xlUp)).Name = CTeam
I = 0
Next J
Range(Range(TeamList).Offset(1, 0), Range(TeamList).Offset(100, 0).End(xlUp)).Name = "Squadre"
Niente:
Application.Goto Reference:=Range(TeamList), scroll:=True
End Sub
Le DEFINIZIONI che trovi sono derivate dall’ esempio inviatomi; se non ti quadrano, o se vengono cambiate, adegua le definizioni. Per qualche settimana mantengo copia del foglio, nel caso che tu abbia qualche domanda in merito.
Puo’ essere eseguita piu’ volte, e gli elenchi costruiti vengono azzerati prima del calcolo dei nuovi elenchi. Potresti associare la macro a un pulsante su Foglio1.
La seconda macro sceglie la scheda dell’ atleta e la incolla su Foglio1, cancellando prima la foto se presente.
Il codice:
- Codice: Seleziona tutto
Sub nikkk()
' Definizioni
SkRoot = "C1" '<< "radice" delle schede
SkAdr = "A1:AI18" '<< Dimensione della scheda
SkDest = "G5" '<< Destinazione della scheda su Foglio1
SkCols = Range(SkAdr).Columns.Count
SkRows = Range(SkAdr).Rows.Count
Sheets("Foglio1").Select
RigaSk = Range("AT1").Value
OffAtl = Range("AU1").Value
If Not IsError(OffAtl) Then GoTo Proced
MsgBox ("Completare la selezione di Squadra e Atleta!" & vbCrLf & vbCrLf & "Abortito")
Exit Sub
Proced:
'Azzera le Immagini
On Error Resume Next
For Each Pict In ActiveSheet.Shapes
NomeImm = Pict.Name
ActiveSheet.Shapes(NomeImm).Select
If Left(NomeImm, 7) = "Picture" Then Selection.Delete
Next Pict
On Error GoTo 0
Sheets("Foglio2").Select
Range(RigaSk).Offset(0, SkCols * (OffAtl - 1)).Range("A1").Select
Selection.Range(SkAdr).Select
Selection.Copy Destination:=Sheets("Foglio1").Range(SkDest)
Sheets("Foglio1").Select
End Sub
Su Foglio2 ci sono innumerevoli lineette (…oltre 4000) di dimensione microscopica, non ho capito la loro funzione; se ti interessa toglierle puoi usare una macro come
- Codice: Seleziona tutto
Sub pippo()
For Each Pict In ActiveSheet.Shapes
NomeImm = Pict.Name
If Left(NomeImm, 4) = "Line" Then
ActiveSheet.Shapes(NomeImm).Select
Selection.Delete
End If
I = I + 1 'Contatore
Next Pict
MsgBox ("Totale " & I & " forme")
End Sub
(SEMPRE 2 copie di backup, prima)
Prova il tutto e fai sapere…
Ciao.
E' proprio di questo che si tratta, questo è il look che deve avere nel foglio1. Il mio problema è capire come i dati si possano mappare nella scheda che ripeto ha quest'aspetto. I dati non li decido io.
Ti ringrazio, vedo cosa viene fuori.
Non ci riesco, le schede sono troppe. Ti ho mandato tramite mp il file su cui sto lavorando.
Grazie per l'intresse che mostrate. Ho inviato il file a Anthony tramite hotmail, visto che interfree non è affidabile. Penso che lui abbia capito il problema. La scheda che deve comparire su foglio1 è una sola, proprio come dice Sal. Quello che non riesco a fare è organizzare dati e foto in modo da poterli richiamare e metterli nel formato della scheda. Comunque la stiamo tirando alla lunga, se vi annoio lasciamo perdere e passiamo ad altro. Se invece volete condividere il file fatemi sapere tramite mp i vostri indirizzi, almeno così non stressiamo Anthony. Ciao 
grazie ancora, faccio un pò di fatica ma ho capito. Volevo aggiungere le riserve ad ogni squadra. Lo spazio è più che sufficiente ma giusto per complicarmi la vita volevo capire come fare. Ho provato ad aggiungere spazio tra le schede e l'organizzazione modificando: