Il tuo foglio ha una struttura cosi' disordinata che l' unico suggerimento che mi sento di dare e' di procedere con una macro autoregistrata.
1) sul foglio GOLAS a ogni immagine assegna il nome della relativa squadra: Selezioni l' immagine, nella "Casella Nome" (a sinistra della barra della formula; ora ci leggi qualcosa come Immagine xy) scrivi il nome da assegnare.
2) poi ti registri una macro; prendiamo l' area del tuo file che parte dalla cella AO58; avvia il registratore di macro mentre
-selezioni l' area col nome della squadra Ac Babalucci (AP60:AU61)
-selezioni l' immagine sottostante della AC Babbalucci e la cancelli
-vai su foglio Golass, selezioni l' immagine Babbalucci, la Copi
-torni su foglio Base, selezioni la cella che deve contenere l' immagine (AP62:AS67), Incolli
-vai nella "Casella nomi" e assegni a questa squadra il nome "XXX_AP62" (cioe' XXX_ seguito dalle coordinate della cella in alto a sx dove l' immagine e' inserita)
Idem con la squadra successiva
-selezioni l' area col nome squadra Ac Fiodena (AV60:BA61)
-selezioni l' immagine sottostante della AC Fiodena e la cancelli
-vai su foglio Golass, selezioni l' immagine Fiodena, la Copi
-torni su foglio Base, selezioni la cella che deve contenere l' immagine (AX62:BA67), Incolli
-vai nella "Casella nomi" e assegni a questa squadra il nome "XXX_AX62"
Idem con ognuna delle squadre successive; fai per cominciare una prova con 4 squadre.
Avrai ottenuto probabilmente un codice come questo:
- Codice: Seleziona tutto
Range("AP60:AU61").Select
ActiveSheet.Shapes.Range(Array("Picture 1")).Select
Selection.Delete
Sheets("GOLASS").Select
ActiveSheet.Shapes.Range(Array("AC BABBALUCCI")).Select
Selection.Copy
Sheets("BASE").Select
Range("AP62:AS67").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "XXX_AP62"
Selection.Name = "XXX_AP62"
Range("AV60:BA61").Select
ActiveSheet.Shapes.Range(Array("Picture 1476")).Select
Selection.Delete
Sheets("GOLASS").Select
ActiveSheet.Shapes.Range(Array("AC FIODENA")).Select
Selection.Copy
Sheets("BASE").Select
Range("AX62:BA67").Select
ActiveSheet.Paste
Selection.ShapeRange.Name = "XXX_AX62"
Selection.Name = "XXX_AX62"
'Etc etc
A questo punto modifica il codice come segue:
- Codice: Seleziona tutto
'prima squadra:
Range("AP60:AU61").Select
mypic = Selection.Range("A1").Value 'AA
On Error Resume Next 'AA
ActiveSheet.Shapes.Range("XXX_" & Selection.Range("A1").Offset(1, 0).Address(0, 0)).Delete 'MM
On Error GoTo 0 'AA
Sheets("GOLASS").Select
ActiveSheet.Shapes.Range(mypic).Select 'MM
Selection.Copy
Sheets("BASE").Select
Range("AP62:AS67").Select
ActiveSheet.Paste
' Selection.ShapeRange.Name = "XXX_AP62" 'VA CANCELLATA
Selection.Name = "XXX_" & ActiveWindow.RangeSelection.Range("A1").Address(0, 0) 'MM
'seconda squadra:
Range("AV60:BA61").Select
mypic = Selection.Range("A1").Value
On Error Resume Next
ActiveSheet.Shapes.Range("XXX_" & Selection.Range("A1").Offset(1, 0).Address(0, 0)).Delete
On Error GoTo 0
Sheets("GOLASS").Select
'etc etc
Le righe aggiunte sono marcate "AA"; quelle modificate "MM"; una istruzione e' da cancellare
A questo punto fai una prova con le prime N squadre su cui hai sviluppato la macro: cambia i nomi delle squadre, lancia la macro e controlla che le immagini siano corrette.
Se Si, allora registra la macro che riguarda le successive squadre, modifica il codice come gia' detto e accoda il nuovo codice corretto a quello della prima macro per avere una macro unica.
Se ti da' fastidio la "vibrazione dello schermo" durante l' esecuzione, allora inserisci in testa al codice
Application.ScreenUpdating = False e poi
Application.ScreenUpdating = True subito prima di End Sub
Ciao