



Allego il file
http://www.mediafire.com/?80zj4nzdosi/
Moderatori: Anthony47, Flash30005
. . . la disposizione delle schede non è in orizzontale ma in verticale. . .
Range(SkRoot).Offset((J+K) * SkRows, I * SkCols).Select
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 K = 0 To 2 '<<<<<NUOVO CICLO
For I = 0 To SkPerRow - 1
Range(SkRoot).Offset((J + K) * SkRows, I * SkCols).Select
ActiveCell.Offset(0, 1).Copy _
Destination:=Range(TeamList).Offset(100, J + 2).End(xlUp).Offset(1, 0)
Next I
Next K
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
MsgBox ("Questo e' il nuovo Elenco di: " & vbCrLf & "Squadre, Posizione sk, Composizione squadre")
End Sub
Range(RigaSk).Offset(, SkCols * (OffAtl - 1)).Range("A1").Select
Selection.Range(SkAdr).Select
Selection.Copy Destination:=Sheets("Foglio1").Range(SkDest)
=RESTO(CONFRONTA(D5;INDIRETTO(B5);0)-1;AV1)
=QUOZIENTE(CONFRONTA(D5;INDIRETTO(B5);0)-1;AV1)
OffAtl = Range("AU1").Value
OffAtly = Range("AU2").Value
On Error GoTo 0
Sheets("Foglio2").Select
Range(RigaSk).Offset(OffAtly * SkRows, SkCols * (OffAtl - 0)).Range("A1").Select
#NOME?
Range(RigaSk).Offset(OffAtly * SkRows, SkCols * (OffAtl - 0)).Range("A1").Select
=INT((CONFRONTA(D5;INDIRETTO(B5);0)-1)/AV1)
Torna a Applicazioni Office Windows
macro per copiare dati tra fogli stessa cartella Autore: ANTONIO1105 |
Forum: Applicazioni Office Windows Risposte: 7 |
estendere automaticamente area stampa di tabelle excel Autore: wallace&gromit |
Forum: Applicazioni Office Windows Risposte: 2 |
Trovare una corrispondenza parziale di testo in excel Autore: libraio |
Forum: Applicazioni Office Windows Risposte: 9 |
Visitano il forum: Nessuno e 36 ospiti