gestione turni

Hai un problema con Excel?

Nuova discussione

gestione turni
di cavallo (utente non iscritto) data: 23/05/2013 17:59:16
Ciao a tutti ho creato 1 foglio turni in Excel per gestire le turnazioni dei dipendenti dell'azienda in cui lavoro.
Premetto che non ho usato VBA nelle formule del foglio perché le turnazioni dei dipendenti sono facili da gestire in quanto sono cicliche (6 giorni di lavoro continui e quattro di riposo in dettaglio 2 mattine 2 pomeriggi 2 notti 4 a casa per tutte le squadre)
Mi sono accorto che purtroppo mi incappo in un errore quando l'anno diventa bisestile e ovviamente il foglio non lo gestisce, non essendo impostato giusto, saltando dal 28 di febbraio al 1 di marzo e ovviamente non riporta le turnazioni corrette.
come posso rimediare?

Avrei anche un secondo problema, se cosi si può chiamare, a cui non riesco trovare rimedio su internet (e poi sono anche alle prime armi :P ):
consideriamo i 4 riposi. Se il secondo o il terzo riposo sono di giovedì non deve apparire il riposo ma deve apparire la mattina
esempio:
prendete in esame il foglio Gennaio e guardate dalla cella p6 a v6

D L M M G V S
p6 q6 r6 s6 t6 u6 v6
3 3 / / / / 1

il riposo si presenta dalla cella r6 alla cella u6 dove s6 e t6 sono rispettivamente il secondo e il terzo riposo (/). Vorrei che il programma riconoscesse t6 come giovedì e scrivesse 1 al posto di / come da esempio sotto:

D L M M G V S
p6 q6 r6 s6 t6 u6 v6
3 3 / / 1 / 1

oppure prendete in esame le celle da y9 a ac9.
In questo caso il riposo si presenta dalla cella z9 alla cella ac9 dove in questo caso la cella aa9 e ab9 sono rispettivamente il secondo e il terzo riposo.

M M G V S D
y9 z9 aa9 ab9 ac9
3 / / / /

in questo caso aa9 è il secondo riposo ed è giovedì; deve apparire 1 al posto di /

M M G V S D
y9 z9 aa9 ab8 ac9
3 / 1 / / 1

questa procedura deve essere inserita a tutti i mesi ma non deve modificare la parte riguardante il primo e l'ultimo riposo in quanto si farebbero 7 giorni di lavoro continuo.
Grazie anticipatamente.
ecco il file salvato con Excel 2010

h t t p : //www.4shared.com/folder/sZ7gHMTC/_online.html (modificato il link per lo scaricamento del file)
di cavallo (utente non iscritto) data: 24/05/2013 20:17:54
nessuna idea?
di Raffaele_53 (utente non iscritto) data: 24/05/2013 22:13:52
C'è una cosa che non capisco bene, ammettiamo che il secondo riposo casca di giovedi bisogna mettere 1 subito dopo continuare con la medesima stringa uguale, oppure togliendo un 1?
Pertanto come da esempio la 5 squadra nel mese di gennaio farà dal 1 al 18 una sequenza simile //112233/1//112233 oppure //112233/1//12233 ???

Ps. Hai notato che il giorno 10/1/2013 avrai 6 persone al mattino?
Si può modificare il files drasticamente?
di cavallo (utente non iscritto) data: 25/05/2013 06:37:44
Ciao raffaele. Innanzi tutto ti ringrazio per la risposta. Inizio a dirti che la stringa rimane del tipo 112233////112233 etc per tutto l'anno e per tutte le squadre. La stringa cambia solo se ci sono dei giovedi nel secondo o nel terzo riposo e diventa così 112233/1//112233 oppure 112233//1/112233. Sono a conoscenza che posso avere 6 persone in turno e anche che può capitare di avere fino a due "recuperi" al mese durante i riposi. Facciamo così perché per contratto dobbiamo fare 232,5 giorni l'anno e con questa turnazione non riusciamo a farli. Il file lo puoi stravolgere, l'ho fatto così perché sono alle prime armi e non ho trovato nulla in rete che faceva al mio caso
di cavallo (utente non iscritto) data: 25/05/2013 06:44:01
scusa ancora raffaele ma hai trovato anche la soluzione per l'anno bisestile?
di cavallo (utente non iscritto) data: 25/05/2013 06:48:58
Ciao raffaele. Innanzi tutto ti ringrazio per la risposta. Inizio a dirti che la stringa rimane del tipo 112233////112233 etc per tutto l'anno e per tutte le squadre. La stringa cambia solo se ci sono dei giovedi nel secondo o nel terzo riposo e diventa così 112233/1//112233 oppure 112233//1/112233. Sono a conoscenza che posso avere 6 persone in turno e anche che può capitare di avere fino a due "recuperi" al mese durante i riposi. Facciamo così perché per contratto dobbiamo fare 232,5 giorni l'anno e con questa turnazione non riusciamo a farli. Il file lo puoi stravolgere, l'ho fatto così perché sono alle prime armi e non ho trovato nulla in rete che faceva al mio caso
di Raffaele_53 (utente non iscritto) data: 25/05/2013 09:39:56
Per l'anno bisestile è facile
Vedo di farti una macro per la stringa 112233/1//112233 oppure 112233//1/112233.
di cavallo (utente non iscritto) data: 25/05/2013 09:54:05
ok ti ringrazio. Scusa per il doppio post ma tornando indietro col browser lo ha fatto doppio
di cavallo (utente non iscritto) data: 25/05/2013 12:08:50
ok ti ringrazio. Scusa per il doppio post ma tornando indietro col browser lo ha fatto doppio
di Raffaele_53 (utente non iscritto) data: 25/05/2013 21:07:54
Alcune cose:
Non sono bravo col VBA e ho fatto del mio meglio.
Con le formattazioni condizionali stai attento (appensantisce molto), non saprei se dire di rimmetterle come prima.

L'anno bisestile (facile), che mi ha fatto disperare nella Macro.

Cerco di spiegarlo....
A) Le celle verdi in inserimento_dati C6:C20, servono per ricomiaciare l'anno bisogna per forza reinserire i valori della prima giornata dell'anno.
Se noti la tabella in Blu in NH:NI, si capisce che se finisco l'anno prima dopo aver fatto il primo turno ex 3 (quale sarà dei due 33, allora numeri dispari il primo, pari il secondo), oppure le formule non Ti calcolano piu i 2/3 turni in riposo di Giovedi.

B) dopo aver immesso una data e sistemate le celle verdi, premi il bottone in alto.

Per VF, non riesco a metterlo per 2003 ( ci sono oltre 360 colonne), però se riesci a correggemmi qualche errore, Ti ringrazio.
1) Anche se mi spiego male ( non sono riuscito a trovare quel comando che senza activare i vari fogli per copiare diverse celle senza fare copia/incolla.
2) Se riesci anche a vedere se possibile tramite la copia trasferire anche la formattazione condizionale.

Mi sembra aposto vedete Voi. Un saluto
Allegato inserito
di cavallo (utente non iscritto) data: 26/05/2013 14:59:51
uaoooo!!!Più di quello che avevo chiesto...
L'ho guardato alla veloce perché dovevo andare al lavoro. Mi sembra che ci sia tutto ciò che mi serve. Ora ti chiedo solo 2 info. Siccome,per problemi di spazio, devo ridimensionare tutte le celle in modo che le tabelle stiano in un foglio a4, posso metere "G" al posto di "Gio" nella funzione "Se"?se si come procedo? basta modificare una cella e copiare la formula sulle altre?
Per semplificare l'inserimento dei dati è possibile mettere delle scritte al posto dei numeri (1234567890 al posto della turnazione) tipo prima mattina, seconda mattina, primo pomeriggio, etc fino al quarto riposo?Se fosse troppo complicato lascia stare così va più che bene era solo per facilitare l'inserimento.
Se vuoi dimmi solo come procedere che il file lo modifico io senza farti perdere tempo.
PS non ho capito cosa intendi nel post che hai scritto.
Ciao e grazie tanto
di Raffaele_53 (utente non iscritto) data: 27/05/2013 19:02:39
A riguardo il "GIO", puoi farlo solo e unicamente perchè "G" e univoco se fosse la "M" non fuzionerebbe.

Per le sigle invece....
in NG1:NG10, metti m1,m2,p1,p2,n1,n1,r1,r2,r3,r4
Modifichi la convalida dati nelle celle verdi e selezioni i valori corretti.
Pertanto il 1° lavoratore che fà "m1" a fine anno farà "n1", significa che nel 2014 dovrai mettere "n2"

La formula da trascinare giu/destra (colonna=1/1/2013, riga=1_lavoratore)

=SE(CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO)=8;1;SE(CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO)=9;1;CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO)))
di cavallo (utente non iscritto) data: 28/05/2013 18:41:34
Ciao ancora.
Riguardo alla sigla "Gio" modificata in "G" ho risolto cambiando la formula in

=SE(E(D$3="G";CERCA.VERT(RESTO((D$4+$C6)-$A$2;10);$NH$1:$NI$10;1;FALSO)=8);1;SE(E(D$3="G";CERCA.VERT(RESTO((D$4+$C6)-$A$2;10);$NH$1:$NI$10;1;FALSO)=9);1;CERCA.VERT(RESTO((D$4+$C6)-$A$2;10);$NH$1:$NI$10;2;FALSO)))

ed è funzionante.
Ora se volessi cambiare le turnazioni in m1,m2,p1,p2,n1,n2,r1,r2,r3,r4 invece di 1,2,3,4,5,6,7,8,9,0 la formula che mi hai dato nell'ultimo post è sbagliata.

=SE(CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO)=8;1;SE(CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO)=9;1;CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO)))

Per primo non cerca "G" e poi mi non inserisce le turnazioni nei vari giorni dell'anno e mi appaiono vari #.
E' nato un altro problema che non avevo preventivato. A casa uso office 2010 ma al lavoro usano office 2003(credo). E' possibile modificare la tua macro in modo che invece di salvare tutti i mesi sullo stesso file, li salva in un file separato cosichè questo rimane intatto e lo uso a casa e il file nuovo lo uso al lavoro con office 2003?
di cavallo (utente non iscritto) data: 28/05/2013 18:42:47
P.S. allegato il nuovo file modificato da me.
di Raffaele_53 (utente non iscritto) data: 28/05/2013 23:45:53
>>>Per primo non cerca "G"
Forse prima di rispondere che "NON FUNZIONA" dovresti leggere e capire.
La formula non cerca "G" , per il semplice motivo che RESTO da un numero ecquivalente forse ad 8 oppure 9 (dei numeri che Ti davano fastidio). Da qui il confronto nella ricerca.
A me funziona benissimo, casomai modificala Tu come desideri.
Ps. Tra VBA 2010 (che non conosco) e 2003, presumo non esistano differenze.
Pps. Casomai posso solo dire che andava incollata in D6
di Raffaele_53 (utente non iscritto) data: 28/05/2013 23:59:56
Poi che Tu abbia fatto saltare la convalida dati dei cantieri (eravamo d'accordo se non erro, si sceglieva un cantiere e premendo il bottone cerca trovava tutte le date di quel cantiere).
Inutile mettere una data nella cella, la macro non funziona oppure va modificata radicalmente.
di Raffaele_53 (utente non iscritto) data: 29/05/2013 00:14:19
L'ultimo post non lo considerare, era riferito ad altro post
di Raffaele_53 (utente non iscritto) data: 29/05/2013 01:48:17
Mi sono riletto il post e mi corrego.....
La formula non dava errori, invece non trovava i riposi da lavorare come nella prima formula.
Come detto per m1-m2 nella tabella i riposi saranno r1-r3, per l'anno prossimo r2-r4.

La formula in D6 =SE(E(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10)=8;D$3="G");1;SE(E(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10)=9;D$3="G");1;CERCA.VERT(RESTO((D$4+CERCA.VERT($C6;$NG$1:$NI$10;2;FALSO))-$D$2;10);$NH$1:$NI$10;2;FALSO))) e trascinarla giu/destra in tutto l'anno.
Vedi allegato

Ps. Per il forum, non c'è la possibilità di modificare il post, cioè se sbaglio posso solo farne un'altro?
di cavallo (utente non iscritto) data: 29/05/2013 05:30:47
chiedo scusa se mi sono espresso male e non volevo neanche giudicare il tuo operato (sui forum si fraintende e non si ha modo di spiegarsi subito:p).
Come avevo già detto nel primo post sono alle prime armi con le formule di excel riesco a gestire formule non complesse ma quelle nidificate proprio non ce la faccio.
Volevo anche sottolineare che la formula che mi avevi dato prima non funzionava sicuramente per un mio errore e non per uno tuo. Ripensando a quello che ho fatto ho sbagliato sicuramente qualcosa nella convalida dati. Quando arrivo a casa do un occhiata il nuovo file e cerco di capirci qualcosa.
Nella convalida devo mettere l'intervallo NG1:NI10? Quindi 3colonne e 10 righe? Quindi scrivo cosi nelle celle
m1 1 1
m2 2 1
p1 3 2
p2 4 2
n1 5 3
n2 6 3
r1 7 /
r2 8 /
r3 9 /
r4 0 /
è giusto così?
ora non sono a casa forse riesco a modificarlo oggi pomeriggio. grazie ancora.
di Vecchio Frac data: 29/05/2013 11:34:30
cit. " Ps. Per il forum, non c'è la possibilità di modificare il post, cioè se sbaglio posso solo farne un'altro?"
---> Purtroppo non c'è la possibilità, attualmente, di modificare un inserimento una volta inviato (anche perchè viene spedita l'email ai partecipanti). Puoi riscrivere il post, magari inserendo "errata corrige" in testa per far capire che stai operando una modifica ad un post precedente.
di cavallo (utente non iscritto) data: 29/05/2013 15:06:06
Ok lavoro perfetto non potevo chiedere di meglio

di Raffaele_53 (utente non iscritto) data: 29/05/2013 19:48:25
VF, grazie
Per salvare i fogli in formato excel 2003, devi fare alcuni passaggi.

A)Cerca la RIGA* Application.ScreenUpdating = False
1-Dim Files As String' questa la metti sotto
---->Application.ScreenUpdating = False
Application.DisplayAlerts = False' questa dopo

B) Prima della penultima riga
Application.DisplayAlerts = True' devi inserire questa
Application.ScreenUpdating = True

C) crea un cartella dove Vuoi, nell'esempio ho scelto Archivio
D) Ora modifica il codice sotto,
Mettendo alle xxxxxx il nome del Tuo Pc-casa
Casomai modifica il percorso della cartella mettendo anche la ""finale

E) Ricopia le 3 righe di codice corrette e incollale subito sotto dove vedi scritto NEXT X (24 volte se non erro)

       Files = "C:UserslelloDesktopArchivio" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8

di cavallo (utente non iscritto) data: 05/06/2013 11:08:39
Ciao sono di nuovo qui. Grazie ancora a Raffaele per il grandissimo aiuto che mi ha dato per la macro. Ho modificato la macro come mi ha detto e tutto funziona. Avrei ancora 1 cosa da chiedere. Con la nuova modifica la macro crea i nuovi fogli, ma li lascia aperti. Ce un modo di modificare la macro in modo che li chiuda in automatico? Un'altra cosa con la stessa macro dovrei aggiungere altri fogli da copiare e salvare per Excel 2003. Come procedo? I nomi dei fogli sono Riassuntivo e Luglio modificato. Grazie ancora allego il codice

Option Explicit
Sub CopiaMesi3()
Dim F1 As Worksheet, F2 As Worksheet, F3 As Worksheet, F4 As Worksheet, F5 As Worksheet, F6 As Worksheet, F7 As Worksheet, F8 As Worksheet, F9 As Worksheet, F10 As Worksheet, F11 As Worksheet, F12 As Worksheet, FF As Worksheet
Set F1 = Sheets("Gennaio")
F1.Range("d3:Ah23").ClearContents
Set F2 = Sheets("Febbraio")
F2.Range("d3:Ah23").ClearContents
Set F3 = Sheets("Marzo")
F3.Range("d3:Ah23").ClearContents
Set F4 = Sheets("Aprile")
F4.Range("d3:Ah23").ClearContents
Set F5 = Sheets("Maggio")
F5.Range("d3:Ah23").ClearContents
Set F6 = Sheets("Giugno")
F6.Range("d3:Ah23").ClearContents
Set F7 = Sheets("Luglio")
F7.Range("d3:Ah23").ClearContents
Set F8 = Sheets("Agosto")
F8.Range("d3:Ah23").ClearContents
Set F9 = Sheets("Settembre")
F9.Range("d3:Ah23").ClearContents
Set F10 = Sheets("Ottobre")
F10.Range("d3:Ah23").ClearContents
Set F11 = Sheets("Novembre")
F11.Range("d3:Ah23").ClearContents
Set F12 = Sheets("Dicembre")
F12.Range("d3:Ah23").ClearContents
Set FF = Sheets("Inserimento_dati")
Dim x As Long, Data, Mese As Long, Giorni As Long, Y As Long, YY As Long, Col1 As Long, Col2 As Long, Col As Long
Dim Files As String
Application.ScreenUpdating = False
FF.Activate
 Y = 4
Data = "29/2/" & Year(F1.Cells(2, 2))
    If IsDate(Data) Then
        Giorni = 366
        Else
        Giorni = 365
     End If
     If Giorni = 366 Then
     'gennaio
            FF.Range(FF.Cells(6, 4), FF.Cells(20, 34)).Copy
            F1.Activate
            F1.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F1.Cells(3, 3 + x) = FF.Cells(3, Y)
            F1.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8


      FF.Activate
      'febbraio
    
            FF.Range(FF.Cells(6, 35), FF.Cells(20, 63)).Copy
            F2.Activate
            F2.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 28
            F2.Cells(3, 3 + x) = FF.Cells(3, Y)
            F2.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
      FF.Activate
      'marzo
            FF.Range(FF.Cells(6, 64), FF.Cells(20, 94)).Copy
            F3.Activate
            F3.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F3.Cells(3, 3 + x) = FF.Cells(3, Y)
            F3.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
       FF.Activate
       'aprile
            FF.Range(FF.Cells(6, 95), FF.Cells(20, 124)).Copy
            F4.Activate
            F4.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F4.Cells(3, 3 + x) = FF.Cells(3, Y)
            F4.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'maggio
            FF.Range(FF.Cells(6, 125), FF.Cells(20, 155)).Copy
            F5.Activate
            F5.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F5.Cells(3, 3 + x) = FF.Cells(3, Y)
            F5.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'giugno
            FF.Range(FF.Cells(6, 156), FF.Cells(20, 185)).Copy
            F6.Activate
            F6.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F6.Cells(3, 3 + x) = FF.Cells(3, Y)
            F6.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'luglio
            FF.Range(FF.Cells(6, 186), FF.Cells(20, 216)).Copy
            F7.Activate
            F7.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F7.Cells(3, 3 + x) = FF.Cells(3, Y)
            F7.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
       FF.Activate
        'agosto
            FF.Range(FF.Cells(6, 217), FF.Cells(20, 247)).Copy
            F8.Activate
            F8.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F8.Cells(3, 3 + x) = FF.Cells(3, Y)
            F8.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'Settembre
            FF.Range(FF.Cells(6, 248), FF.Cells(20, 277)).Copy
            F9.Activate
            F9.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F9.Cells(3, 3 + x) = FF.Cells(3, Y)
            F9.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'ottobre
            FF.Range(FF.Cells(6, 278), FF.Cells(20, 308)).Copy
            F10.Activate
            F10.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F10.Cells(3, 3 + x) = FF.Cells(3, Y)
            F10.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'Novembre
            FF.Range(FF.Cells(6, 309), FF.Cells(20, 338)).Copy
            F11.Activate
            F11.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F11.Cells(3, 3 + x) = FF.Cells(3, Y)
            F11.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'Dicembre
            FF.Range(FF.Cells(6, 339), FF.Cells(20, 369)).Copy
            F12.Activate
            F12.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F12.Cells(3, 3 + x) = FF.Cells(3, Y)
            F12.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
Else
       FF.Activate
        'gennaio
            FF.Range(FF.Cells(6, 4), FF.Cells(20, 34)).Copy
            F1.Activate
            F1.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F1.Cells(3, 3 + x) = FF.Cells(3, Y)
            F1.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
       FF.Activate
      'febbraio
    
            FF.Range(FF.Cells(6, 35), FF.Cells(20, 62)).Copy
            F2.Activate
            F2.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 28
            F2.Cells(3, 3 + x) = FF.Cells(3, Y)
            F2.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
      'marzo
            FF.Range(FF.Cells(6, 63), FF.Cells(20, 93)).Copy
            F3.Activate
            F3.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F3.Cells(3, 3 + x) = FF.Cells(3, Y)
            F3.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
       FF.Activate
       'aprile
            FF.Range(FF.Cells(6, 94), FF.Cells(20, 123)).Copy
            F4.Activate
            F4.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F4.Cells(3, 3 + x) = FF.Cells(3, Y)
            F4.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'maggio
            FF.Range(FF.Cells(6, 124), FF.Cells(20, 154)).Copy
            F5.Activate
            F5.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F5.Cells(3, 3 + x) = FF.Cells(3, Y)
            F5.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'giugno
            FF.Range(FF.Cells(6, 155), FF.Cells(20, 184)).Copy
            F6.Activate
            F6.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F6.Cells(3, 3 + x) = FF.Cells(3, Y)
            F6.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
                Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'luglio
            FF.Range(FF.Cells(6, 185), FF.Cells(20, 215)).Copy
            F7.Activate
            F7.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F7.Cells(3, 3 + x) = FF.Cells(3, Y)
            F7.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
       FF.Activate
        'agosto
            FF.Range(FF.Cells(6, 216), FF.Cells(20, 246)).Copy
            F8.Activate
            F8.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F8.Cells(3, 3 + x) = FF.Cells(3, Y)
            F8.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'Settembre
            FF.Range(FF.Cells(6, 247), FF.Cells(20, 276)).Copy
            F9.Activate
            F9.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F9.Cells(3, 3 + x) = FF.Cells(3, Y)
            F9.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'ottobre
            FF.Range(FF.Cells(6, 277), FF.Cells(20, 307)).Copy
            F10.Activate
            F10.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F10.Cells(3, 3 + x) = FF.Cells(3, Y)
            F10.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'Novembre
            FF.Range(FF.Cells(6, 308), FF.Cells(20, 337)).Copy
            F11.Activate
            F11.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 30
            F11.Cells(3, 3 + x) = FF.Cells(3, Y)
            F11.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
        FF.Activate
        'Dicembre
            FF.Range(FF.Cells(6, 338), FF.Cells(20, 368)).Copy
            F12.Activate
            F12.Range("D6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        For x = 1 To 31
            F12.Cells(3, 3 + x) = FF.Cells(3, Y)
            F12.Cells(4, 3 + x) = FF.Cells(4, Y)
            Y = Y + 1
        Next x
        Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls" 'da cambiare la cartella
        ActiveSheet.Copy
        ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8
    End If
       
            MsgBox ("Fatto")
        FF.Activate
        Application.DisplayAlerts = True
        Application.ScreenUpdating = True
End Sub

di Vecchio Frac data: 05/06/2013 12:10:10
Mamma mia che lungo codicione... sicuri che non si possa ottimizzare? Ecco una bella sfida ^_^
Comunque a naso, dopo aver salvato un foglio lo puoi chiudere; salvandolo diventa il foglio attivo quindi basterà fare così:
ActiveSheet.SaveAs Filename:=Files, FileFormat:=xlExcel8 ActiveWorkbook.Close

Per "aggiungere altri fogli" intendi altri file cartella di Excel o altri Sheets?
Workbooks.Add

p.s. "Files" non è un buon nome per una variabile.
di cavallo76 (utente non iscritto) data: 05/06/2013 12:42:01
la cartella di cui sto parlando ha in totale 16 fogli. Ora la macro mi salva 11 fogli al di fuori della cartella in 11 nuovi file *.xls nella macro devo aggiungere altri 2 fogli che ho aggiunto io dopo l'aiuto di raffaele_53.
Per chiudere i fogli provo la dritta che mi hai suggerito poi ti faccio sapere.
di Cavallo (utente non iscritto) data: 08/06/2013 12:53:55
Rieccomi e scusate se non ho più risposto.
Dunque ho aggiunto al codice la riga
----> ActiveWorkbook.Close
e giustamente i fogli salvati li chiude in automatico. Ora però ogni volta che salva un foglio mi appaiono i seguenti messaggi

h t t p://imageshack.us/photo/my-images/69/68791499.jpg/

e

h t t p://imageshack.us/photo/my-images/855/89512067.jpg/

dove devo cliccare per 24 volte.
Altro problema che non capisco è che adesso mi salva i fogli con nome Gennaio 1899, Febbraio 1899, etc (forse ho sbagliato qualcosa nella digitazione).
Ennesimo problema se i fogli che ho appena salvato li metto su 1 altro pc dove non c'è il file madre non mi appaiono i nomi dei dipendenti.
Un altra cosa ho bisogno anche di estrapolare dal file madre altri 2 fogli che si chiamano Riassuntivo e Luglio modificato.
Per finire sarebbe possibile salvare i fogli nella stessa directory del file madre e magari in una sotto cartella chiamata "Giornaliera"?
Allego il file e grazie ancora.
di cavallo76 (utente non iscritto) data: 08/06/2013 12:58:52
Scusate il file è protetto da password "soris"
di Vecchio Frac data: 08/06/2013 19:55:14
Devi per forza salvare in un formato diverso dal tuo Excel 2010?
Per il nome del file, devi intervenire su
Files = "C:" & Cells(3, 2).Value & Year(FF.Cells(2, 4)) & ".xls"
dove ovviamente la cella D2 dovrebbe contenere l'anno che costruisce il nome del file.
Controlla che la cella abbia un valore corretto.
di cavallo76 (utente non iscritto) data: 08/06/2013 23:48:19
purtroppo si devo salvarlo con formato excel 2003 perché non posso aprire il file sul lavoro.
Domani vedo se la compilazione è corretta (sicuramente nob la è) e correggo l'errore.
Per quanto riguarda il salvataggio, non capisco il motivo degli avvisi che appaiono. In teoria le celle dei fogli che vengono salvati e che non esistono in excel 2003, sono vuote. Non dovrebbero apparire i messaggi.
Per estrapolare gli altri sheet dalla cartel e salvarli su una nuova cartel hai qualche idea?
ci siamo quasi ma....
di cavallo76@email (utente non iscritto) data: 16/06/2013 23:27:29
dunque ragazzi, ho modificato molto il file da quello creato da raffaele_53 ed è quasi perfetto funziona bene anche su office 2003. Ora però alla chiusura del file mi appare un messaggio molto noiso che mi obbliga ogni volta a cliccare su si o no. Il messaggio mi sembra dire che "ci sono degli appunti non salvati e chiudendo il file potrebbero non esere più disponibili.Vuoi renderli disponibili? Cliccando no libererai spazio virtuale". Non è nulla di che mi sta solo antipatico.
vi serve vedere il file?Posto uno screen del messaggio? ditemi voi e grazie in anticipo

Vuoi Approfondire?