Macro copia e incolla in base al testo cercato ??

[scirea1976]

Salve a tutti, un saluto particolare a Anthony che mi ha risolto diversi problemi... andiamo a noi...
Sto usando un foglio excel per il fantacalcio, purtroppo ogni volta che aggiorno la classifica ... sono costretto a fare diversi passaggi di copia e incolla per sistemare le squadre in base alla distanza che hanno dal primo.
Ora mi chiedevo... se è possibile creare una macro che mi sistemi un insieme di celle in base ad un determinato testo che si trova in un'altra cella.
Mi spìego meglio postando un immagine Quindi in A66 c'e la prima squadra in classifica, in F66 c'è la seconda, in L66 c'è la terza e cosi via....
In questo caso sono gia ordinate infatti in A66 c'è la squadra Lionheart e sotto nelle celle che vanno da A69 a D84 c'è tutta la squadra Lionheart ( le squadre sono evidenziate con il riquadro rosso).
Per non perdere i dati e creare danni ho creato un bottone in Q194 che mi copia tutte le squadre nelle colonne BN:CG.
Vi posto un file per essere piu chiari.... La macro mi dovrebbe eseguire questi passaggi:
1) Trovare il testo contenuto di A66 e cercarlo nelle colonne che vanno da BN a CG.(nell'esempio si trova in BN69)
2) Una volta trovato, dovrebbe selezionare tutta la squadra (BN69:BQ84) e copiarla in A69:D84 ....
Trova F66 in BN:CG, e copia l'intera squadra in F69:I84..... trova L66 in BN:CG e copia l'intera squadra in L69:O84... e cosi via con la quarta .... fino alla fine.
Spero di essere stato abbastanza chiaro... grazie per la pazienza...

[scirea1976]

Ho scordato di postare l'esempio, eccolo http://www.realfanta2009.altervista.org/torneo1.xls
chiedo scusa anche per l'immagine ..ops

[scirea1976]

ragazzi ma non c'è nessun che mi puo dare una mano .. ..

[Flash30005]

Una macro che potrebbe funzionare se elimini un paio di colonne nello schema dei dati è questa:

Codice: Seleziona tutto

Sub RiordinaSchema()
Application.ScreenUpdating = False
For RRC = 14 To 34
ColC = ((RRC - 13) Mod 4)
If ColC = 0 Then ColC = 4
ColC = ColC + (ColC - 1) * 3
RigaC = ColC * 21 + 48
SqC = Range("B" & RRC).Value
    For RR = 69 To 174 Step 21
        For CC = 65 To 80 Step 5
        SSO = Cells(RR, CC)
        Cells(RR, CC).Select
            If SqC = SSO Then
                Range(Cells(RR, CC), Cells(RR + 15, CC + 3)).Copy Destination:=Cells(RigaC, ColC)
            End If
        Next CC
    Next RR
Next RRC
Application.ScreenUpdating = True
End sub

Le colonne da eliminare sono la BX
e la colonna K (in quanto alterano la coerenza che hanno le tabelle: ci sono due colonne di distanza invece che una)
quindi prima elimina la BX e poi la colonna K
per la colonna K dovrai ripristinare lo schema che va da A1 a U65
Copiando le righe intere dalla riga1 alla riga 65 del tuo file originale e incollarle nel file che stai modificando

Abbina un pulsante o forma alla nuova macro e avrai le squadre come hai richiesto

fai sapere
Ciao

[scirea1976]

Vi faro sapere.. intanto grazie mille.. ciao

[scirea1976]

Flash ho modificato lo schema togliendo le due colonne K e BX, ho dovuto cambiare tutte le macro, anche quella che mi copiava lo schema, poi ho mischiato le squadre e provando la macro che mi hai postato non va.. forse sbaglio qualcosa...
Ti ho postato il file definitivo a questo indirizzo http://www.realfanta2009.altervista.org/torneo2.xls
In fondo ho inserito un pulsante per riordinare lo schema, puoi assegnarli la macro esatta e poi postarmi il file gia completo ?
Grazie...
P.S. le squadre evidenziate in nero sono quelle nella posizione sbagliata.. ciaoo

[Flash30005]

In effetti ho dovuto aggiustare un paio di riferimenti...
La macro funzionate con il primo file "torneo1" modificato (senza le due colonne BX e K) è questa:

Codice: Seleziona tutto

Sub RiordinaSchema()
Application.ScreenUpdating = False
AggRiga = 0
For RRC = 14 To 34
ColC = ((RRC - 13) Mod 4)
If ColC = 0 Then ColC = 4
If ColC = 1 Then AggRiga = AggRiga + 1
ColCI = 1 + (ColC - 1) * 5
RigaC = AggRiga * 21 + 48
SqC = Range("B" & RRC).Value
    For RR = 69 To 174 Step 21
        For CC = 65 To 80 Step 5
        SSO = Cells(RR, CC)
        Cells(RR, CC).Select
            If SqC = SSO Then
                Range(Cells(RR, CC), Cells(RR + 15, CC + 3)).Copy Destination:=Cells(RigaC, ColCI)
            End If
        Next CC
    Next RR
Next RRC
Application.ScreenUpdating = True
End Sub


E' chiaro che togliendo quelle due colonne le macro precedenti sono da correggere
ma non sapendo precisamente cosa debbano fare è meglio che le riguardassi tu
altrimenti dovrei studiarmi quel/quei codici per adattarli a questo nuovo schema che è sicuramente più omogeneo (anche se il foglio è pieno di celle unite e righe di dimensioni al di sotto della norma)

Ti invio il file con la macro "RiordinaSchema" situata nel modulo1 alla quale abbinerai un pulsante di comando
download

Fai sapere
Ciao

[scirea1976]

Ok, funziona... mi riordina lo schema in base alla classifica... se avro dei problemi ti farò sapere..
Grazie mille
ciao

[scirea1976]

Ciao
Flash avrei bisogno di una cortesia, puoi postarmi l'ultima macro anche per questo file
http://www.realfanta2009.altervista.org/asta1.xls
io ho provato ma non ci riesco... grazie

[Flash30005]

Ecco la macro

Codice: Seleziona tutto

Sub RiordinaSchema()
Application.ScreenUpdating = False
AggRiga = 0
For RRC = 12 To 19
ColC = ((RRC - 11) Mod 4)
If ColC = 0 Then ColC = 4
If ColC = 1 Then AggRiga = AggRiga + 1
ColCI = 1 + (ColC - 1) * 5
RigaC = AggRiga * 21 + 25
SqC = Range("B" & RRC).Value
    For RR = 46 To 67 Step 21
        For CC = 65 To 80 Step 5
        SSO = Cells(RR, CC)
        Cells(RR, CC).Select
            If SqC = SSO Then
                Range(Cells(RR, CC), Cells(RR + 15, CC + 3)).Copy Destination:=Cells(RigaC, ColCI)
                GoTo SaltaRRC
            End If
        Next CC
    Next RR
SaltaRRC:
Next RRC
Application.ScreenUpdating = True
End Sub


Per i prossimi schemi cerca di evitare le celle unite

Ciao

[scirea1976]

Perfetta funziona... vediamo se confrontandole riesco a capire qualcosa.
Grazie tante
ciao

[Flash30005]

...vediamo se confrontandole riesco a capire qualcosa...

Secondo me dovresti capire il "principio di funzionamento" di una

poi capirai anche il perché dell'altra.

Ciao