Media su più fogli

[Anthony47]

C'e' un motivo per cui, non sapendo aggiustare la macro, devi modificare il layout dei dati?

Allora, mi immagino i tuoi dati da colonna A a G (li immagino perche' non ce ne sono nel file allegato); noi li riepilogheremo in colonna B:H, mentre in colonna A metteremo, come facevamo prima, il nome del progetto che immagino ora sia in E1,
La macro dovrebbe essere:

Codice: Seleziona tutto

Sub ZRiepZA()
Dim tSh As Worksheet, I As Long, iGnora, myNext As Long, cLast As Long
Dim hShI As Long, myMatch
'
Set tSh = Sheets("Z_RIEPILOGO")         '<<<1 Il foglio in cui si crea ex-novo il riepilogo
iGnora = Array("RIASSUNTO", "Z_RIEPILOGO", "NON COMPILARE", "PIVOT")    '<<<2 I Fogli da ignorare
'azzera foglio target
tSh.Cells.ClearContents
'ciclo per esaminare tutti i worksheets
For I = 1 To Worksheets.Count
'usa colonna A per individuare prima riga libera in z_riepilogo
    myNext = tSh.Cells(Rows.Count, "A").End(xlUp).Row + 1       'ZZZ
    With Sheets(I)
'esamina l'elenco degli "ignora"
        myMatch = Application.Match(.Name, iGnora, 0)
        If IsError(myMatch) Then                  'Il foglio non e' in elenco
            If hShI = 0 Then hShI = I               'Indice de primo foglio copiato
'calcola l'ultima riga usata esaminando colonna A:       'ZZZ
            cLast = Evaluate("max(row(" & .Name & "!7:2000)*(len(" & .Name & "!A7:A2000)>2))")      'ZZZ
            If cLast < 8 Then cLast = 8
'Copia foglio corrente accodandolo a z_riepilogo:
            tSh.Cells(myNext, 2).Resize(cLast - 7, 7).Value = .Range(.Range("A8"), .Cells(cLast, "G")).Value    'ZZZ
'Copia nome del progetto in colonna A di z_riepilogo:
            tSh.Cells(myNext, 1).Resize(cLast - 7, 1).Value = .Range("E1").Value    'ZZZ
        End If
    End With
Next I
'Compila le intestazioni su riga 1 di z_riepilogo, anche quelle vuote nei fogli di copia:
tSh.Cells(1, 1) = "Esempio"
For I = 1 To 8
    If Sheets(hShI).Cells(7, I).Value <> "" Then
        tSh.Cells(1, I + 1) = Sheets(hShI).Cells(7, I).Value
    Else
        tSh.Cells(1, I + 1) = Chr(65 + I) & Chr(65 + I)
    End If
Next I
'Aggiorna pivot-table:
'Sheets("PIVOT").Range("A4").PivotTable.PivotCache.Refresh
End Sub


Dico "la macro dovrebbe essere" perche' senza dati non ho fatto nessun collaudo.
Le righe modificate (sono partito dalla mia macro, non da quella modificata trovata nel file pubblicato) sono marcate ZZZ.

Ciao

[Fabiolan]

Grazie Antony, adesso rifunziona.
Solo due piccole cose, come mai se l'ultimo numero presente nella colonna A è ad una sola cifra (1 ,2 etc), questo non viene copiato?
Se è una limitazione, farò partire i miei codici dal numero 10.
Grazie

[Fabiolan]

Antony ho provato a sostituire >1 nella seguente parte di codice A7:A2000>2. Con >1 copia anche se l'ultimo numero è a due cifre. Ho provato con >0 per copiaeere anche se il codice è a una cifra ma si incasina tutto. Posso lasciare >1 senza problemi o ho cambiato wualcosa che non centrava con il problema?

[Anthony47]

Ti avevo segnalato che trovavo strano che nel file pubblicato a fine marzo in colonna O ci fossero o dei valori oppure (fino a riga 1290) una formula che restituiva in ogni caso una stringa di almeno di 1 crt; questa situazione mi porto' a usare Lunghezza >2 per individuare l'ultima riga usata; come hai scoperto si puo' anche usare >1, ma non >0 perche' (se il foglio e' rimasto come quello a cui faccio riferimento) allora ti selezionera' sempre fino a riga 1290
Secondo me quella formula non ha ragione di esserci in quella colonna; se la rimuovi allora potrai usare Lunghezza>0 e trovera' anche i codici a 1 cifra.

Ciao

[Fabiolan]

Ciao Anthony47 sto utilizzando benissimo la tua macro e funzione tutto.
Ti vorrei chiedere se fosse possibile apportare una modifica, ovvero:
alla macro da te realizzatomi, invece che il foglio Z_riepilogo debba cancellarsi ogni volta e copiare poi in seguito il contenuto di ogni foglio, è possibile aggiungere in coda al foglio Z_riepilogo il contenuto dei fogli non ancora letti? Ti spiego, così potrei eliminare il foglio utilizzato per quella lettura così da non avere tanti fogli quante sono le volte in cui leggo i codici a barre.
Ti ringrazio anticipatamente

[Anthony47]

Se vuoi "accodare" senza prima "cancellare" allora basta eliminare l'istruzione tSh.Cells.ClearContents

Ciao

[Fabiolan]

Perfetto, cosi posso eliminare il foglio dopo la lettura?

[Anthony47]

Se hai la certezza che in Z_Riepilogo ci siano le informazioni prima contenute nei fogli esaminati allora puoi eliminare i fogli originali; oppure (meglio) "archiviarli" da qualche parte.

Ciao

[Fabiolan]

Ciao Anthony47, cosa intendi per "archiviarli"? Potrebbe essere la migliore soluzione
Grazie

[Anthony47]

Archiviarli vuol dire metterli in archivio per ogni evenienza.
Ad esempio sposti il foglio dal tuo file a un file nuovo che chiami "Archivio_2007_05" e salvi questo file (che quindi continua a incrementare come numero di fogli contenuti); da come l'ho detta evidentemente penso che a Giugno creerai e userai un file "Archivio_2007_06", e cosi' via.
Per spostare un foglio, tasto dx sul tab col nome foglio, scegli "Sposta o copia".

Ciao

[Fabiolan]

Ottima idea. Volendo si può automatizzare con una macro?

[Anthony47]

Si

[Fabiolan]

Ho pensato che un messaggio con "Vuoi spostare il foglio nell'archivio?" S/NO sarebbe esteticamente bello.
Devo aprire un altro topic per chiederti questa macro? Io so far visualizzare il messaggio, ma non spostare in automatico il foglio nell'archivio.
Grazie in anticipo

[Anthony47]

Direi che e' ora che cominci a imparare come registrare una macro, perche' in quel modo hai la soluzione a portata di mano...

Per le istruzioni e i primi suggerimenti su come registrare una macro:
viewtopic.php?f=26&t=103893&p=622593#p622593

Prova e (solo) se non riesci vedremo come aiutarti.

Ciao

[Fabiolan]

Ciao Anthony47 dopo vari tentativi, sono arrivato a questa macro, che però vorrei modificassi un pò tu perché la mia conoscenza di vba finisce qui.

Codice: Seleziona tutto

Sub SPosta()
Dim NomeFoglio
Dim tSh As Worksheet, I As Long, iGnora, myNext As Long, cLast As Long
Dim hShI As Long, myMatch

ActiveSheet.Name = Format(Range("B4").Value, "yyyy-mm-dd") & Range("d1").Value
NomeFoglio = ActiveSheet.Name
   
    op = MsgBox("Vuoi spostare il foglio?", vbYesNo)
If op = vbYes Then

       Application.ScreenUpdating = True
    Workbooks.Open Filename:="C:\Users\fabio\Desktop\magazzino\Storico\Storico.xlsx"
    Application.ScreenUpdating = True
    Workbooks("Magazzino.xlsm").Sheets(NomeFoglio).Move After:=Workbooks("Storico.xlsx").Sheets(1)
   
    Application.Workbooks("Storico.xlsx").Close SaveChanges:=True
 
    Else
End If

   
End Sub


1)se potessi rendere tutto molto generale, ovvero fare in modo che anche se io cambio i nomi dei fogli, non debba cambiare anche il codice.
2)non riesco a far funzionare Application. ScreenUpodating, vorrei che non si vedesse il passaggio da un foglio all'altro. Ho provato a mettere la riga in diverse posizioni, ma non cambia niente
3)quando si chiude il foglio Storico.xlsx esce l'avviso "Informazioni personali etc." è possibile togliere quell'avviso?
4)come faccio a fare in modo che nel foglio Storico non ci sia il Foglio1 che viene creato di default da Excel quando si crea un file?

Grazie e scusa le tante domande

[Anthony47]

Nel codice pubblicato mi pare che vai a spostare l' ActiveSheet del Workbooks("Magazzino.xlsm") nel file "Storico.xlsx"; quindi e' gia' indipendente dal nome del foglio.
Se non vuoi vedere lo schermo "sballottare" allora devi usare Application.ScreenUpdating = False (per bloccare l'aggiornamento dello schermo) e Application.ScreenUpdating = True per riabilitare.
Tieni presente che secondo me queste bellurie ostacolano il debug della macro.

Per evitare quel messaggio metti subito prima l'istruzione Application.DisplayAlerts = False e subito dopo pero' ripristina la messaggistica con Application.DisplayAlerts = True

Per evitare che in un file ci sia un Foglio1 ti basta cancellarlo, l'importante e' che si cia almeno un foglio.

Ciao

[Fabiolan]

Anthony, ho provato così ma rimane lo sfarfallio. Come posso risolvere?

Codice: Seleziona tutto

Sub SPosta()
Dim NomeFoglio
Dim tSh As Worksheet, I As Long, iGnora, myNext As Long, cLast As Long
Dim hShI As Long, myMatch

'ActiveSheet.Name = Format(Range("B4").Value, "yy-mm-dd") & Range("d1").Value
NomeFoglio = ActiveSheet.Name
   
   

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Workbooks.Open Filename:="C:\Users\fabio\Desktop\magazzino\Storico\Storico.xlsx" '<<<metti la destinazione BFP
   
    Workbooks("Magazzino.xlsm").Sheets(NomeFoglio).Move After:=Workbooks("Storico.xlsx").Sheets(1)
   
    Application.Workbooks("Storico.xlsx").Close SaveChanges:=True
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
   
 
   


 
 

   
End Sub


[Anthony47]

L'uso di ScreenUpdating e' corretto, se ancora sfarfalla potrebbe essere un limite della tua grafica

Invece Application.ScreenUpdating = False erroneamente non e' seguito da Application.ScreenUpdating = True

Ciao