cercare una squadra

[raimea]

ciao

tramite macro vorrei filtrare tutte le partite
relative ad una squadra

in fgl squadra in cella O3 con menu a tendina
seleziono la squadra da cercare

il fgl dove cercare la squadra e' >> 4_archivio
in col P da P14

individuate le righe che contengono la squadra
vorrei importare in fogl squadra
da riga E7, il contenuto delle colonne
da F:P del fgl 4_archivio

se possibile , vorrei importare
sia il contenuto che il relativo colore

vi allego il file
https://www.dropbox.com/scl/fi/42c4r2vkh1bs46a29zq34/cerca_squadra.xlsm?rlkey=culidofjuk6n4g3rwk7lc2jnw&st=63mv0drj&dl=0

ciao

[Anthony47]

Spesso il registratore di macro ci da' una soluzione sufficiente...
L'ho fatto io (e in tutte le mie macro il registratore interviene almeno al 50%!), poi con qualche modifica ho generalizzato il codice. Il concetto e' stato di utilizzare il filtro sulla colonna P.
Il risultato e' questo:

Codice: Seleziona tutto

Sub GetMatches()
'
    myTeam = "=*" & Sheets("squadra").Range("O3").Value & "*"   'AGGIUNTA
    Sheets("Squadra").Range("E7:O1000").ClearContents           'Aggiunta, clear SQUADRA
    Sheets("4_archivio").Select
    Columns("P:P").Select                                       'Modificata
    Selection.AutoFilter
'Questa l'ho modificata:
    ActiveSheet.Range("P:P").AutoFilter Field:=1, Criteria1:= _
        myTeam, Operator:=xlAnd
'    Range("F17").Select
    Range("F1").End(xlDown).Select                              'Invece che la riga precedente
'    Range(Selection, Selection.End(xlDown)).Select
'    Range(Selection, Selection.End(xlToRight)).Select
'    Range("F17:P78").Select
'    Selection.Copy
'    Sheets("squadra").Select
'    Range("E7").Select
'    ActiveSheet.Paste
'    Sheets("4_archivio").Select
'aggiunta in sostituzione:
    Range(Selection, Selection.End(xlDown)).Resize(, 11).Copy _
      Destination:=Sheets("squadra").Range("E7")
    Application.CutCopyMode = False
    ActiveSheet.Range("P:P").Select                         'Modificata
    Selection.AutoFilter
End Sub

Non spaventarti, ho lasciato le istruzioni originali anche se le ho sostituite solo per mostrare come sono intervenuto, in qualche caso per generalizzare l'istruzione, in altri per semplificare.
Puoi cancellare tutte le righe "commentate" e lasciare solo il codice utile

Prova

PS: per copiare il colore il metodo piu' semplice e' copiare Tutto o PasteSpecial/Format; in questo modo si copia anche il bordo delle celle, che al momento e' differente tra foglio SQUADRE e 4_ARCHIVIO; se il riultato e' brutto si puo' aggiungere la sola copia colore

[raimea]

ciao

funziona

con un piccolo imprevisto,
ma non sono riuscito capire come risolvere

quando copia le righe filtrate da fgl >> 4_archivio
e le incolla in fgl squadre:

copia anche erroneamente
anche delle piccole immagini contenute nella riga 13
mentre le righe che contengono le partite partono da riga 14



ho provato la macro passo-passo con F8 ma...

PS: per copiare il colore il metodo piu' semplice e' copiare Tutto o PasteSpecial/Format; in questo modo si copia anche il bordo delle celle, che al momento e' differente tra foglio SQUADRE e 4_ARCHIVIO; se il riultato e' brutto si puo' aggiungere la sola copia colore

queste cosette riesco a risolverle in autonomia , grazie
-----

si e' vero
molte cose con il registratore si riescono a fare
io questa non ero riuscito,

ciao

[Anthony47]

copia anche erroneamente
anche delle piccole immagini contenute nella riga 13

E' vero ma non ci avevo fatto caso

Esegui una volta questa macro, che impostera' il formato di quelle immagini come "ridimensiona e muovi con le celle":

Codice: Seleziona tutto

Sub ReForm()
Dim Shp As Shape
'
Sheets("4_Archivio").Select
For Each Shp In ActiveSheet.Shapes
    If Shp.Type = msoPicture Then
        If Shp.TopLeftCell.Column > 6 And Shp.TopLeftCell.Column < 16 And Shp.TopLeftCell.Row = 13 Then
            Shp.Placement = xlMoveAndSize
        End If
    End If
Next Shp
End Sub


Dovrai cancellare a mano le immagini nel frattempo copiate su 4_ARCHIVIO

[raimea]

ciao

fatto tutto ok

come dicevo ora tutti i " fronzoli.. "

riesco a gestimerli

grazie