Codice per turno annuale

Hai un problema con Excel?

Nuova discussione

Codice per turno annuale
di trump61 data: 20/06/2014 15:45:22
Ciao sono di nuovo qui, vorrei poter realizzare un foglio dove da questa stecca di 52 settimane realizzare il turno annuale di ogni singolo operaio, ma non riesco ad elaborare un modo per poterlo fare, in pratica il primo operaio ad esempio se il 1 Gennaio fosse Lunedì ad es, Rossi fa la prima riga poi '8 gennaio fa la seconda e così via, Bianchi il primo gennaio fa la seconda riga e l'8 gennaio fa la terza cosi per 33 operai per 52 settimane.
C'è qualche anima pia che mi da una mano a partire.
Grazie

P	M	M1	N	E	R	P
M	M1	N	R	P	P2	M
M1	N	E	R	P2	P	M
N	E2	R	P2	M	M1	N
R	P2	P	M2	M	N	E2
R	P	P2	M	M1	E	R
P2	M	M	M1	N	E	R
P	M2	M	N	E2	R	P2
M2	M	N	R	P	M	M1
M	N	E2	R	P	P	M
N	E	R	P	P	M	N
R	P	P	P	M	N	R
P	M	M2	M	N	E2	R
M	M	M	N	E	R	P
M	N	N	R	P	P	M
N	E	R	P	M2	M	M2
R	P	P	P	M	N	E
R	P	P	M	M	E	R
P	P	M	M	N	E	R
P	M	M	N	E	R	P
M	M	N	R	P	P	P
M	N	E	R	P	P	M
N	E	R	P	P	M	N
E2	R	P	P	M	M2	E
R	P	P	M	M	E	R
P	P	M	M	N	E	R
P	M	M	N	E	R	P
M	M	N	R	R	P	P
M	N	R	E2	P	M	M
N	E	R	P	M	M	N
R	P	P	P	M	N	E
R	P	P	M	M	E	R
P	M	M	M	N	E	R
P	M	M1	N	E	R	P
M	M1	N	R	P	P	M
M1	N	E	R	P	P	M
N	E2	R	P	M	M1	N
R	P	P	M	M	N	E2
R	P	P	M	M1	E	R
P	M	M	M1	N	E	R
P	M	M	N	E2	R	P
M	M	N	R	P	M	M1
M	N	E2	R	P	P	M
N	E	R	P	P	M	N
R	P	P	P	M	N	R
P	M	M	M	N	E2	R
M	M	M	N	E	R	P
M	N	N	R	P	P	M
N	E	R	P	M	M	M
R	P	P	P	M	N	E
R	P	P	M	M	E	R
P	P	M	M	N	E	R

di Raffaele_53 (utente non iscritto) data: 23/06/2014 21:17:01
Desidero sapere se Ti trovi bene con le formule oppure col VBA.
VBA sarebbe meglio, però se non sei in grado di gestirlo sarebbe un problema.
di trump61 data: 23/06/2014 21:42:59
Ciao, no lo vorrei fare in codice, no me la cavo o meglio me lo cavavo. però se lo leggo il codice lo capisco.
il problema e che non riesco ad impostarlo. In formule lo avevo realizzato anni fa da poco abbiamo cambiato la ciclazione, quando sono andato a modificare il foglio mi sono reso conto di come ho ragionato per realizzarl e non riesco a farlo funzionare. quindi preferirei in codice.

Grazie per la tua attenzione
di raffaele_53 (utente non iscritto) data: 24/06/2014 00:49:48
L'ho già fatto in alcuni post
Il primo non era mio, poi ho modificato il codice per altri quesiti.
Non trovo l'originale che mi da i dovuti suggerimenti, si tratta solo di calcolare un ciclo (persone/anno)
Ad oggi modificherei alcune parti(dove assegnando una data precisa ad un lavoratore preciso) creo i turni/stringa.
Finche questi sono unici, va tutto bene? Devo trovare il modo di farlo "quasi "universale" con le stringhe preposte "che potrebbero variare..., sia personale che turnazione".

Ci riprovo, dammi qualche giorno. Forse non sara universale "magari solo per te" se riesco.
di trump61 data: 24/06/2014 01:32:14
Grazie aspetto fiducioso
di lepat (utente non iscritto) data: 24/06/2014 09:04:12
ti dispiace allegare un file di esempio con i dati, la spiegazione dei simboli ed il risultato desiderato ?
di trump61 data: 25/06/2014 00:48:50
Ciao, ho allegato il file che avevo creato 10 anni fa circa realizzato con le formule a dire il vero questa è la versione che ho tentato di aggiornare ma non mi ricordo che ragionamento ho fatto a quei tempi per realizzarlo. in pratica scegliendo dalla combo anno e Nome agente, si crea sul foglio uno schema che rende visibile per ogni agente il turno per tutto l'anno, poi con delle macro offre diversi modi di stampa. Tutti i miei colleghi me lo stanno chiedendo ma mi sono arrenato. Poi vorrei realizzarlo con il codice VBA, perchè è lìunica parte che grazie al vostro aiuto ancora è rimasto con le formule.
Grazie di nuovo
di Raffaele_53 (utente non iscritto) data: 26/06/2014 00:13:44
Ho visto il Tuo file, per me non è di facile soluzione.
Non volendo toccare il tuo. Ho provato a fare un foglio (per quello che intendevo). Non avendo trovato il file originale che dicevo mi ritrovo spiazzato.
Ci sono 364 turni che anche "sigillando una data iniziale ad un'utente", questo dopo 7 anni (senza contare il bisestile) si mangia 7 giorni.
A dire il vero sarei quasi buon punto, devo verificare alcuni particolari che si potrebbero creare nel prossimo futuro.

Ps. avrei preferito svilupparlo con una stringa unica lineare (però ho visto la "stampa mensile", che rimane posizionata in un foglio unico*.
Pps. In questo momento sono fermo alle annate future.
Ppps. qui ci divento matto.
di trump61 (utente non iscritto) data: 26/06/2014 03:15:37
Ciao, non so come anni fa ci arrivai, è vero che ho passato tanto tempo e stavo praticamente sempre davanti al PC(Ci stavo a "rota" come si dice per i tossicodipendenti") non sono riuscito a capire come azz.. az z ho ragionato, non tanto per la complessità delle formule perchè sono semplici. Ho pensato di realizzarlo in vba per renderlo sempre modificabile semplicemente. ma sono bloccato, perche' magari saperlo, sono arrivato alla conclusione che devo fare un ibrido, più facile a dirsi che a farsi. Se riesci a darmi una dritta ti sarò molto grato perchè se riesco in questo step, sempre con il tuo o il vostro aiuto, avrò finalmente trasformato un file fatto di un milione di formule in un file più sicuro e più semplice da modificare.

grazie per il tuo impegno
di Raffaele_53 (utente non iscritto) data: 26/06/2014 05:27:23
Forse ci sono riuscito, devi controllare bene i risultati.
Non è quello che desideravo, sono sicuro che ci sarà di meglio.

Ho ricalcato più/meno il Tuo schema. Nel foglio "nomi ci sono delle regole determinanti...
Col A = Nomi (uno sotto l'altro senza celle vuote)
Col C:I i Tuoi turni
Col F:L servono alla macro per ricreare delle stringhe uniche dei turni.
Le celle in M sono importanti, l'unica cella che puoi modificare è la cella M1
M1 = Alla data 1/1/2001 è stato assegnato l'Utente_1 che rimarranno legati per sempre.
Però siccome il 2001 cominciava con un lunedi, anche il 2007 cominciava col lunedi (il prossimo sarà il 2018).
Per velocizzare il processo al meglio puoi cambiare la data in M1 mettendo l'ultima annata che inzia di lunedi = 1/1/2007
di trump61 data: 26/06/2014 09:10:08
Ciao, grazie per la tua disponibiltà, ti volevo chiedere, anche a te ci mette molto ad elaborare i dati?
di Raffaele_53 (utente non iscritto) data: 26/06/2014 10:36:09
Meno di due secondi.
Comunque prova a vedere i risultati che ottieni, se sono giusti penso di poter diminuire ancora il tempo d'elaborazione.
di trump61 data: 26/06/2014 20:32:03
Ciao ore li controllo, però quando clikko sul pulsante ci mette almeno 4-5 minuti. sicuramente è un mio problema ora provo ad indagare.

Grazie
di trump61 data: 27/06/2014 09:48:07
Ciao la turnazione è giusta, solo che ci mete circa 2 minuti, stavo guardando il codice non mi sembra così pesante.
comunque grazie per la tua disponibilità
di Raffaele_53 (utente non iscritto) data: 28/06/2014 00:35:59
Ho messo un timer ed'Eseguito in :0,1869812 minuti/secondi
Come scritto, ho modificato la cella in foglio NOMI-->M1 in 1/1/2007 (si risparmia 6 anni d'elaborazione.

Ti riallego il files per sicurezza.
Ps. Hai provato su altri PC?
Pps. Hai scritto qualcos'altro sotto le celle scritte in foglio NOMI sotto i dati che sono presenti in colonna A, C,D,E,F,G,H,I.....??? Solo in questo modo potrei capire tutta questa lentezza.
Il fatto che tramite Uriga chiami l'ultima riga aumenta tantissimo le righe da eseguire.
Mà per cosi pocchi dati 2 secondi sono già troppi

Ppps. Ho messo a metà codice un'altro Msgbox (un domani toglilo), per valutare se la parte inziale quella incriminata, oppure la parte finale. A me risultano similari
di trump61 data: 30/06/2014 14:53:22
Ciao, scusami se ti rispondo solo adesso, ma mi è caduto il Gatto dal terzo piano è non ho avuto il tempo i accendere il PC. Ritornando al vecchio file (il nuovo lo devo ancora vedere), se non ho aperto il file dove dovrò inserire il tuo codice è veloce, mentre se sto usando quel file si rallenta come ti avevo detto. Mi è venuto il dubbio che per i problemi che ti ho detto sopra ma non ho potuto verificare, dipenda dal fatto che in un foglio ho inserto il codice nel Worksheet_SelectionChange, anche se il resto del codice va normalmente, però ho visto che in quel foglio anche scorrere il foglio è lento.
di trump61 data: 30/06/2014 21:04:07
Ciao era come pensavo, tolto il codice che ti ho detto nella risposta precedente il tuo file è velocissimo. Non so perche' succeda questa cosa.Le azioni dell'altro codice dovrebbero intervenire quando in quel foglio cambio il dato su una cella selezionata. Ma se sto agendo addirittura su un altro file non riesco a collegarli. Tu sai dirmi perchè succede.
Comunque ti ringrazio tantissimo, purtroppo in questi giorni non ci sto tanto con la testa, sia per le condizioni del mio gatto sia per l' importo delle spese.
di trump61 data: 30/06/2014 21:14:54
Sono sempre io ho tolto il codice,dal foglio("Variazione") Worksheet_SelectionChange e l'ho messo in Worksheet_Change era veloce ma non faceva quello che serviva a me, quindi ho rinserito il codice in Worksheet_SelectionChange e adesso è veloce, boh!!!!
di Raffaele_53 (utente non iscritto) data: 30/06/2014 22:26:20
Non sono molto bravo, però...
Io/Tu non abbiamo mai parlato del Worksheet_Change
Naturale che se il codice è destinato ad essere usato in questo modo...

Ad ogni variazione di cella nel foglio, interviene il Worksheet_Change.
Due righe, una all'inizio e alla fine del codice, non fàrà scatenare l'evento

Application.EnableEvents = False
macro
Application.EnableEvents = True
di trump61 data: 01/07/2014 08:53:44
Ciao, Non va bene, perchè non considera che il primo giorno dell' anno non sempre è lunedì. ho visto che nel foglio nomi usi la funzione' Resto' per determinare quanti giorni ci sono prima del primo lunedì dell' anno che ad esempio nel 2014 sono 5, però poi la tabella che si crea parte comunque dal primo giorno della tabella dei turni che dovrebbe essere un lunedì. Scusami lo so che ci dovrei mettere un po del mio ma in questi giorni non ci sto molto con la testa non riesco a concentrarmi. Per esempio P- M-M1-N-E -R-P che è la prima settimana da M1 non da P perchè il 1-1-14 è mercoledì, spero di essermi spiegato.
Comunque ti ringrazio sei gentilissimo, nonostante la mia non collaborazione
di trump61 data: 01/07/2014 10:20:15
Ciao, sono sempre io non riesco a capire il ragionamento che fai nella colonna M M1 = 1-1-2001 perchè inizi da questa data? M2 = data dell'anno di cui si vuole avere la tabella dei turni ok M3 vuota M4 non ho caapito cosa vuoi ottenere con la funzione "Confronta" cerchi la posizione del nome che hai selezionato con la combobox, poi non capisco perche fai l valore numerico trovato -1 e lo moltiplichi per 7. M5 Usi la funzione "Resto" ma non ho capito perche fai la differenza con il 1-1-2001 le altre due poi non ho proprio capito, scusami ti faccio queste osservazioni per cercare di capire come funziona

Un saluto
di Raffaele_53 (utente non iscritto) data: 01/07/2014 13:40:16
Sapevo che potevo aver sagliato qualcosa, Tu hai detto che era giusto e non ho fatto ulteriori controlli.
La formula in M2, serve per conoscere il primo Lunedi dell'anno = 6/1/2014 (anche se non mi serve a nulla)

La formula in M5, serve a determinare nel giro di qualche anno (quanti giorni "multiplo di 7" verranno sfasati)
Ho corretto un mio errore di calcolo--->=RESTO(DATA(Turni!A1;1;1)-M1;364)

Premesso che uso le righe come numeri per rappresentare DATE, in colonna K ricreo una stringa Univoca legata all'Utente1. Partendo dalla data in M1 = (1/1/2007) * tre cicli sono sufficienti

Come detto l'utente1 nel 2007 fara il primo turno (Foglio Nomi= C1:I1), siccome i turni sono 364 al 31/12/2007 ricomincia..., il 29/12/2008 ricomincia..., il 28/12/2009 ricomincia..., ecc ecc sino all'anno 2014, dove iniziera i turni il 23/12/2003 e ricomincia... il 22/12/2014
Pertanto il 1/1/2014 avrà di turno (anche se non di lunedi N,R,P,P2,M,(M1),N,E,R,P2,P,M ecc ecc
(M1)=lunedi che ecquivale alla stringa (Foglio Nomi= C3:I3)

Ho eliminato la colonna L e ho modificato il codice di conseguenza/snellito. 1,7 secondo

* ricorda nel 2018 di cambiare tale cella (al massimo nel 2019).
Allego nuovo files
di trump61 data: 01/07/2014 14:22:49
Scusa è colpa mia mi sono spiegato male, i turni vanno da lunedì a domenica, quindi la prima stinga della tabella dei turni non può iniziare dal 1-1-2014 perchè in quella data è mercoledì, io pensavo che tu usasti la funzione "Resto" per calcolare dove far iniziare a scrivere la prima stringa.
di Raffaele_53 (utente non iscritto) data: 01/07/2014 15:02:13
Non capisco dove Ti stai perdendo (io sono in tilt).
L'utente1 è legato da una data = 01/01/2007 (per sempre)
Calcolando dal 1/1/2007 al primo gennaio dovrà fare il primo gennaio = N, segue nei giorni R,P,P2,M,(M1),N,E,R,P2,P,M ecc ecc

Quest'anno non inizia di Lunedi pertanto dal 1/1 al 5/1 farà R,P,P2,M,(M1).
Il 6/1/2014, il primo lunedi dell'anno farà N,E,R,P2,P,M (che è la terza stringa), dato che dal 2007 al 2014 i turni si sono sfasati di 14 giorni.
di Raffaele_53 (utente non iscritto) data: 01/07/2014 15:52:23
>>>i turni si sono sfasati di 14 giorni
Di 9 giorni
di trump61 (utente non iscritto) data: 02/07/2014 12:17:16
Ciao, da oggi ho la mente più serena e posso applicarmi di più. Tu usi la data 1-1-2007 perchè viene di lunedì giusto? il problema credo che sia dovuto al fatto(errore mio che non l'ho detto) che il turno è iniziato ad essere lavorato dal 23 6 2014, con il tuo file in quel giorno l' utente uno non fa la prima riga del turno P -M-M1-N-E- R-P che invece me lo fa il 1-1-2014, credo che il codice vada bene è solo un problema di calibrazione delle settimane dei turni.
Grazie per a tua pazienza
di Raffaele_53 (utente non iscritto) data: 10/07/2014 19:50:48
>>>(errore mio che non l'ho detto) che il turno è iniziato ad essere lavorato dal 23 6 2014
Basta mettere in NOMI = L1 = 23/06/2014
Utente_1 iniziera il 23/06/2014 con P,M,M1,N,E,R,P....ecc ecc

Ps. Invece se desideraVi dire che L'utente_1 il 1/1/2014 doveva iniziare "un determinato turno (tra cui non erra di lunedi)", partendo dalla base di P,M,M1,N,E,R,P ....ecc ecc
Dovrei rivedere il tutto.
Onestamente non capisco più nulla, se non ho indicazioni precise.
di Vecchio Frac data: 11/07/2014 13:35:28
Vi spiacerebbe riallegare il file definitivo?
Ho letto il thread e mi sembra interessante.

cit. "mi è caduto il Gatto dal terzo piano"
---> Ma povera bestia! e adesso come sta?
di Raffaele_53 (utente non iscritto) data: 11/07/2014 15:21:06
Ciao, Ti allego quello che ho fatto io.
di trump61 data: 14/07/2014 12:10:20
Ciao, ho visto solo oggi la risposta. Non avevo capito l'utilizzo delle date nella colonna L. il codice funziona perfettamente, ti chiedo scusa per la mia ignoranza, continuavo a mettere la data di un inizio anno. credevo che avessi scelto il 1-1-2007 perchè il primo anno a ritroso che iniziasse di lunedì. Va benissimo così, ma mi piacerebbe che anche il calendario si calcolasse con il codice perchè purtroppo non sono l'unico a metterci le mani e meno formule ci sono meglio è. Ho letto un tuo vecchio post e avevi fatto una cosa del genere riguardando il calendario, se non ti è di disturbo se mi aiutassi in questa ultima cosa mi farebbe piacere.

Grazie
di Raffaele_53 (utente non iscritto) data: 15/07/2014 17:33:14
Per togliere le formule che compongono il calendario, a meta codice devi mettere subito sotto
>>>Next W 'queste due righe
x = 3
sh1.Range("B3:AF31").ClearContents

Poi nel resto del codice, subito sopra le righe (che teminano con COPY) 13 in totale
Gli metti un ciclo for, calcolando i giorni
Ex gennaio inizia dal 2 al 32
Febbraio bisestile dal 2 al 30
Febbraio normale dal 2 al 29
Marzo come gennaio
Aprile dal 2 al 31 ecc ecc
For x = 2 To 32 sh1.Cells(R, x) = Left(WeekdayName(Weekday(sh1.Cells(R - 1, x) & "/" & sh1.Cells(R, 1) & "/" & sh1.Cells(1, 1) - 1)), 1) Next x x = x + 2
di trump61 data: 15/07/2014 22:47:09
Ora ci provo grazie sei gentilissimo
di trump61 data: 16/07/2014 02:02:22
Ciao sono ancora qui, non sono riuscito ad aggiungere le righe del codice che mi hai scritto per mettere in codice anche il calendario. Non riesco a capire il ragionamento saresti così gentile da mettermi nel codice dei commenti che mi aiutano a comprendere come hai ragionato?
Mi piacerebbe capire, al di là del funzionamento del file(funziona e ti ringrazio) come lo hai realizzato, anche se non sono un genio a scrivere codici di solito comprendo quello che leggo, questa volta non capisco, è vero che sto invecchiando e che negli ultimi anni uso i vba solo quando mi serve e molte cose le ho scordate, ma trovarmi come stavolta ad una cosa a me sconosciuta non mi era mai successo.
ti ringrazio comunque.

di trump61 data: 16/07/2014 02:18:05
Scusami sono sempre qui, non è così che a avrei dovuto modificare il codice?

Next W

X = 3
sh1.Range("B3:AF31").ClearContents


    R = sh2.Cells(6, 12)
    For X = 2 To 32
       sh1.Cells(R, X) = Left(WeekdayName(Weekday(sh1.Cells(R - 1, X) & "/" & sh1.Cells(R, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
    X = X + 2
    
    sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
    sh1.Range("b4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    R = R + 31
    If sh1.Cells(1, 1) Mod 4 = 0 Then
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 28, 11)).Copy
        sh1.Range("b6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 29

di Raffaele_53 (utente non iscritto) data: 16/07/2014 17:39:29
Errare e facile (ho scritto/usato due variabili in modo errato errato) e cambiato sh1.Cells(r-1, x)
x = 3 ---> diventa Y =3

For x = 2 To 32
sh1.Cells(y, x) = Left(WeekdayName(Weekday(sh1.Cells(2, x) & "/" & sh1.Cells(y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
Next x
y = y + 2

Da ricopiare in totale 13 volte "sempre sopra la riga del COPY" calcolando che parte sempre dalla colonna 2 deve finire alla colonna di fine del mese (come scritto sopra). Se Vuoi Ti allego tutto il codice. Tempo impiegato 1,2 secondi
di trump61 data: 17/07/2014 18:53:15
Ciao, se mi posti il codice te ne sarei grato. comunque provo a scriverlo seguendo le tue direttive

di Raffaele_53 (utente non iscritto) data: 17/07/2014 20:31:34
Il codice che oltre ai turni crea il calendario

Option Explicit
Sub Crea_Annata()
Dim sh1 As Worksheet: Set sh1 = Worksheets("Turni")
Dim sh2 As Worksheet: Set sh2 = Worksheets("Nomi")
Dim X As Long, Y As Long, W As Long, R As Long
Application.ScreenUpdating = False
Dim T As Single
    T = Timer
    sh2.Columns("K").ClearContents
    R = sh2.Cells(1, 12)
For W = 1 To 3
    For X = 1 To 52
        For Y = 3 To 9
            sh2.Cells(R, 11) = sh2.Cells(X, Y)
            R = R + 1
        Next Y
    Next X
Next W
Y = 3
R = sh2.Cells(6, 12)
sh1.Range("B3:AF31").ClearContents
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 31
    If sh1.Cells(1, 1) Mod 4 = 0 Then
        For X = 2 To 30
            sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
        Next X
        Y = Y + 2
            sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 28, 11)).Copy
            sh1.Range("b6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            R = R + 29
    Else
        For X = 2 To 29
            sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
        Next X
        Y = Y + 2
            sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 27, 11)).Copy
            sh1.Range("b6").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
            R = R + 28
    End If
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b8").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 31
    For X = 2 To 31
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 29, 11)).Copy
        sh1.Range("b10").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 30
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b12").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 31
    For X = 2 To 31
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 29, 11)).Copy
        sh1.Range("b14").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 30
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b16").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 31
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b18").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 31
    For X = 2 To 31
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 29, 11)).Copy
        sh1.Range("b20").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 30
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b22").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 31
    For X = 2 To 31
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 29, 11)).Copy
        sh1.Range("b24").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
        R = R + 30
    For X = 2 To 32
        sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
    Next X
        Y = Y + 2
        sh2.Range(sh2.Cells(R, 11), sh2.Cells(R + 30, 11)).Copy
        sh1.Range("b26").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Application.ScreenUpdating = True
MsgBox "Eseguito in :" & " " & Timer - T & " " & " minuti/secondi"
Set sh1 = Nothing
Set sh2 = Nothing
End Sub

di trump61 data: 18/07/2014 12:02:04
Grazie sei stato gentilissimo, non ave capito niente
di trump61 data: 19/07/2014 13:34:32
Ciao scusa se torno a scocciarti, sto cercando di far colorare i giorni di pasqua e pasquetta e provando i vari anni nel 2016 va in errore 2017 2018 2015 no, non avrei voluto disturbarti ma di quel codice non riesco proprio a venirne a capo.
di trump61 data: 19/07/2014 13:39:14
Ho notato che va in errore negli anni bisestili 2016 2020
di Raffaele_53 (utente non iscritto) data: 19/07/2014 21:18:21
Va in errore perche è il 29 febbraio
Anche corregendo la parte finale
& sh1.Cells(1, 1) - 1)), 1)
& sh1.Cells(1, 1)) - 1), 1) cosi sarebbe giusta, ma non funziona

Per adesso fai solo questa modifica al mese di febbraio
In alto dopo R As Long aggiungi --->, DData As Date

Subito sotto If sh1.Cells(1, 1) Mod 4 = 0 Then
>>>For X = 2 To 30
>>>sh1.Cells(Y, X) = Left(WeekdayName(Weekday(sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1) - 1)), 1)
>>>Next X

modificalo in questo modo
For X = 2 To 30
DData = sh1.Cells(2, X) & "/" & sh1.Cells(Y, 1) & "/" & sh1.Cells(1, 1)
sh1.Cells(Y, X) = Left(WeekdayName(Weekday(DData - 1)), 1)
Next X

Casomai un domani, lo metti in tutte i FOR X = 2 to xx.
di trump61 data: 19/07/2014 22:34:57
Ciao, non so più come ringraziarti. solo una cosa il turno con la modifica che mi hai suggerito funziona perchè dovrei "Casomai un domani, lo metti in tutte i FOR X = 2 to xx."
Ciao e grazie di nuovo

Vuoi Approfondire?