raggruppare turni

[raimea]

ciao
tramite macro vorrei raggruppare
tutti i turni di un dipendente nel fgl generale.

in D2 selezio il nome del dipendente e sotto ad ogni mese
riporto i suoi turni andandoli a copiare nei vari fogli relativi al mese.

quindi in E6:AG6 mettere i turni di marzo
in E10:AM10 i turni di aprile
ecc... fino a dicembre

(mi e' stato richiesto specific. con macro
xche' con formule qualcuno prima o poi cancelera' ecc...)

nonostante ho provato a fare con cerca.vert ma mi sa che forse, non va oltre all'indice 30 ,
infatti quando devo far prelevare: =CERCA.VERT($D$2;aprile!$B$6:$AE$60;31;FALSO)
mi da errore , fino a indice 30 ok poi dal 31 ko.

vi allego il file
https://db.tt/3qGYyS13

grazie ciao

-------------
PS
per correttezza vi informo , tale richiesta l' ho fatta anche su un altro forum giorni fa, ma al momento sono fermo.

[raimea]

ciao
(sono stato aiutato) questa la macro:

Codice: Seleziona tutto

Private Sub Worksheet_Change(ByVal Target As Range)

Dim AreaMesi As Range
Dim ElencoMese As Range
Dim Cella As Range
Dim UltCol As Integer
Dim Nmese As Integer
Dim NrigaMese As Integer
Dim Dipendente As String


Set AreaMesi = Me.Range("E6:AG6,E10:AM10,E14:AF14,E18:AF18" & _
 ",E22:AM22,E26:AF26,E30:AM30,E34:AF34,E38:AF38,E42:AM42")
NrigaMese = 6

If Target.Count = 1 Then
    If Not Intersect(Target, Me.Range("C2")) Is Nothing Then
        Dipendente = Target.Value
        Application.EnableEvents = False
        AreaMesi.Clear
        For Nmese = 3 To 12
            With Sheets(MonthName(Nmese))
                Set ElencoMese = .Range("B6:B60")
                Set Cella = ElencoMese.Find(Dipendente, , , xlWhole)
                If Not Cella Is Nothing Then
                    UltCol = .Cells(Cella.Row, Columns.Count).End(xlToLeft).Column
                    .Range(.Cells(Cella.Row, 3), .Cells(Cella.Row, UltCol)).Copy Me.Range("E" & NrigaMese)
                    NrigaMese = NrigaMese + 4
                End If
            End With
        Next Nmese
        Application.EnableEvents = True
    End If
End If

Set AreaMesi = Nothing
Set Cella = Nothing
Set ElencoMese = Nothing
End Sub

fa cio che chiedevo
ciao