Come promesso ho modificato la macro e inserito il reparto nella colonna AO (che puoi nascondere)
Ti spiego come funziona:
la prima volta che avvierai la macro non essendoci il reparto del dipendente nella colonna AO
la macro impiegherà tutto il tempo per effettuare la scansione dei 5 fogli.
La seconda volta che effettui l'avvio della stessa macro i tempi saranno ridotti in quanto per ogni dipendente aprirà direttamente il file del reparto di appartenenza.
Nel caso in cui un dipendete abbia cambiato reparto la macro, non trovandolo nel file di appartenenza, scansionerà gli altri fogli e aggiorna la colonna AO in corrispondenza di quel dipendente.
Ultima modifica riguarda il percorso che verrà rilevato in automatico
Inserisci il file "Chiusura Totale" nella direcory "C:\Chiusure"
La directory Chiusure conterrà le sottocartelle Luglio2011, Agosto2011 etc
Pertanto cambiando il mese sul file Chiusura Totale nella cella S4 (ora Luglio) o anno nella cella V4 (ora 2011)
Potrai scansionare con lo stesso foglio il mese e l'anno di tuo interesse solo modificando una o ambedue le celle menzionate.
la macro è questa
- Codice: Seleziona tutto
Sub TrovaDip4()
Dim VRep(5) As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
'Perc = "C:\chiusure\Luglio2011\"
Perc = Application.ThisWorkbook.Path & "\" & Range("S4").Value & Range("V4").Value & "\"
VRep(1) = "stanziale.xls"
VRep(2) = "volante.xls"
VRep(3) = "cinofili.xls"
VRep(4) = "sq.comando.xls"
VRep(5) = "atpi.xls"
UR = Range("C" & Rows.Count).End(xlUp).Row
For RRG = 12 To UR
Rep = Range("AO" & RRG).Value
If Rep = 0 Then
Trovatutti:
TRov = 0
Dip = UCase(Range("C" & RRG).Value)
For Cart = 1 To 5
Workbooks.Open Filename:=Perc & VRep(Cart)
Worksheets("C8").Activate
For RR = 8 To 14 '<<<<<<<<< inserisci il numero righe effettive dei fogli dipendenti
If UCase(Cells(RR, 3).Value) = Dip Then
Range(Cells(RR, 6), Cells(RR, 26)).Copy
Windows("CHIUSURA TOTALE.xls").Activate
Cells(RRG, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("AO" & RRG).Value = VRep(Cart)
GoTo Esci
End If
Next RR
Workbooks(VRep(Cart)).Close savechanges:=False
Next Cart
Esci:
On Error GoTo error_Msgc
Workbooks(VRep(Cart)).Close savechanges:=False
Else
Dip = UCase(Range("C" & RRG).Value)
TRov = 0
Workbooks.Open Filename:=Perc & Range("AO" & RRG).Value
Worksheets("C8").Activate
For RR = 8 To 14 '<<<<<<<<< inserisci il numero righe effettive dei fogli dipendenti
If UCase(Cells(RR, 3).Value) = Dip Then
TRov = 1
Range(Cells(RR, 6), Cells(RR, 26)).Copy
Windows("CHIUSURA TOTALE.xls").Activate
Cells(RRG, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
GoTo Esci2
End If
Next RR
Workbooks(Rep).Close savechanges:=False
If TRov = 0 Then GoTo Trovatutti
Esci2:
Workbooks(Rep).Close savechanges:=False
End If
Next RRG
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Exit Sub
error_Msgc:
Workbooks(Rep).Close savechanges:=False
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
MsgBox "Dipendente non trovato in nessun Reparto", vbInformation
On Error GoTo 0
End Sub
Fai sapere se i tempi sono più accettabili
(chiaramente dopo la prima scansione)
Penso comunque di trovare una ulteriore soluzione per rendere ancora più veloce l'esecuzione
Ciao