Io direi, invece, creare un file che contiene tutti i cantieri magari uno per foglio (fogli omogenei)
il nome foglio avrà il nome del cantiere (cioè un numero)
in ogni foglio inserirai i dati cantiere
ma questo solo tu sai quali dati o dove li inserisci inoltre dove vorrai riaverli quando richiamati.
Partendo dall'esigenza iniziale, invece, avevo ideato una cosa del genere
Come dicevo nel post precedente (del quale non mi hai detto se hai provato la macro)
Devi avere un file con 12 fogli riportanti il nome del mese abbreviato a tre lettere (Gen, Feb, Mar etc)
inoltre inserirai un foglio che chiamerai "Riepilogo"
In un modulo inserisci queste macro (copa l'intero codice e incollalo nel modulo)
- Codice: Seleziona tutto
Public MeseR, NomeF As String, CantiereR As Integer
Sub Avvio()
If UCase(ActiveSheet.Name) = "RIEPILOGO" And MeseR = "" Then
Riepilogo
Else
CompilaScCant
End If
End Sub
Sub CompilaScCant()
NomeFileCant = ThisWorkbook.Name
Perc = ThisWorkbook.Path & "\"
Anno = 2012
NFile = "Costi Operai Impiegati " & Anno & ".xls"
NomeF = ActiveSheet.Name
NomeFCP = ActiveSheet.Name
Application.ScreenUpdating = False
Application.Calculation = xlManual
If UCase(NomeF) = "RIEPILOGO" Then
NomeFCP = MeseR
End If
Set Ws1 = Worksheets(NomeFCP)
Select Case UCase(NomeFCP)
Case "GEN"
MM = 1
GG = 31
Case "FEB"
MM = 2
GG = 29
Case "MAR"
MM = 3
GG = 31
Case "APR"
MM = 4
GG = 30
Case "MAG"
MM = 5
GG = 31
Case "GIU"
MM = 6
GG = 30
Case "LUG"
MM = 7
GG = 31
Case "AGO"
MM = 8
GG = 31
Case "SET"
MM = 9
GG = 30
Case "OTT"
MM = 10
GG = 31
Case "NOV"
MM = 11
GG = 30
Case "DIC"
MM = 12
GG = 31
End Select
DataIni = DateSerial(Year(Date), MM, 1)
DataFine = DateSerial(Year(Date), MM, GG)
Ws1.Range("P2").Value = DataIni
Ws1.Range("S2").Value = DataFine
If UCase(NomeF) = "RIEPILOGO" Then
MioCant = CantiereR
Worksheets(MeseR).Select
GoTo SaltaContr:
End If
Inizio:
MioCant = Application.InputBox("Cantiere")
If MioCant = "" Then
MsgBox "Digitare un Numero Cantiere"
GoTo Inizio
End If
SaltaContr:
MioCant = Val(MioCant)
If IsNumeric(MioCant) Then
If MioCant = 0 Then
MsgBox "Zero non è un Numero Cantiere - Digitare un Numero Cantiere <> da 0"
GoTo Inizio
End If
Ws1.Range("O2").Value = MioCant
Cantiere = MioCant
Set MioCant = Nothing
Ws1.Range("A5:M1000").ClearContents
Ws1.Range("C4:H4").ClearContents
Ws1.Range("A4").FormulaR1C1 = "GG "
Ws1.Range("B4").FormulaR1C1 = "Data"
Workbooks.Open Filename:=Perc & NFile
Set Ws2 = Worksheets("Ore")
Ws2.Activate
UR2 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
UC2 = Ws2.Cells(6, Columns.Count).End(xlToLeft).Column
For RR2 = 7 To UR2
If Ws2.Range("B" & RR2) > DataFine Then GoTo esci
If Ws2.Range("B" & RR2) >= DataIni And Ws2.Range("B" & RR2) <= DataFine Then
Workbooks(NomeFileCant).Activate
For CC2 = 3 To UC2 Step 2
If Ws2.Cells(RR2, CC2).Value = Cantiere Then
Operaio = Ws2.Cells(5, CC2).Value
NumO = Ws2.Cells(RR2, CC2 + 1).Value
DataC = Ws2.Cells(RR2, 2).Value
UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count + 1
ColO = UC1
For CC1 = 3 To UC1
If Ws1.Cells(4, CC1).Value = Operaio Then
UR1 = Ws1.Cells(Rows.Count, CC1).End(xlUp).Row + 1
Ws1.Cells(UR1, CC1).Value = NumO
ColO = CC1
GoTo saltaCC1
End If
Next CC1
Ws1.Cells(4, UC1).Value = Operaio
saltaCC1:
URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 1
For RRS = 5 To URS
If Ws1.Cells(RRS, 2).Value = DataC Then
Ws1.Cells(RRS, ColO).Value = NumO
GoTo saltaRRS
End If
Next RRS
Ws1.Cells(URS, 2).Value = DataC
Ws1.Cells(URS, ColO).Value = NumO
Ws1.Range("B" & URS).NumberFormat = "[$-410]d-mmm;@"
Ws1.Range("A" & URS).FormulaR1C1 = "=RC[1]"
Ws1.Range("A" & URS).NumberFormat = "ddd"
Ws1.Range("A" & URS).HorizontalAlignment = xlLeft
End If
saltaRRS:
Next CC2
End If
Next RR2
esci:
Workbooks(NFile).Close savechanges:=False
URS = Ws1.Cells(Rows.Count, 2).End(xlUp).Row + 2
Ws1.Range("A" & URS).Value = "Tot ore lavorate"
Ws1.Range("A" & URS + 1).Value = "Costo Orario"
Ws1.Range("A" & URS + 2).Value = "Tot Costo"
UC1 = Ws1.Range("A4").CurrentRegion.Columns.Count
For CC1 = 3 To UC1
Ws1.Cells(URS, CC1).FormulaR1C1 = "=SUM(R[-" & URS - 3 & "]C:R[-2]C)"
Next CC1
End If
MeseR = ""
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Sub Riepilogo()
NomeFileCant = ThisWorkbook.Name
Perc = ThisWorkbook.Path & "\"
Anno = 2012
NFile = "Costi Operai Impiegati " & Anno & ".xls"
NomeFCant = ActiveSheet.Name
Set Ws1 = Worksheets(NomeFCant)
Ws1.Cells.ClearContents
Ws1.Range("A1").Value = "Mese"
Application.ScreenUpdating = False
Application.Calculation = xlManual
Workbooks.Open Filename:=Perc & NFile
Set Ws2 = Worksheets("Ore")
Ws2.Activate
UR2 = Ws2.Range("B" & Rows.Count).End(xlUp).Row
UC2 = Ws2.Cells(6, Columns.Count).End(xlToLeft).Column
Workbooks(NomeFileCant).Activate
For RR2 = 7 To UR2
Tr = 0
Mese = Application.WorksheetFunction.Proper(Format(Ws2.Range("B" & RR2), "mmm"))
UC1 = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
For RR1 = 2 To UC1
If UCase(Mese) = UCase(Ws1.Cells(RR1, 1)) Then Tr = 1
Next RR1
If Tr = 0 Then
Ws1.Cells(UC1, 1).Value = Mese
If Mese = "Dic" Then Exit For
End If
Next RR2
For RR2 = 7 To UR2
Mese = Application.WorksheetFunction.Proper(Format(Ws2.Range("B" & RR2), "mmm"))
URS = Ws1.Cells(Rows.Count, 1).End(xlUp).Row + 1
For RR1 = 2 To URS
If UCase(Mese) = UCase(Ws1.Cells(RR1, 1)) Then
For CC2 = 3 To UC2 Step 2
Tr = 0
Cantiere = Ws2.Cells(RR2, CC2).Value
If Cantiere = "" Then GoTo SaltaCC2
UC1 = Ws1.Cells(RR1, Columns.Count).End(xlToLeft).Column + 1
For CC1 = 2 To UC1
If Ws1.Cells(RR1, CC1).Value = Cantiere Then
'Tr = 1
GoTo SaltaCC2
End If
Next CC1
If Tr = 0 Then
Ws1.Cells(1, UC1).Value = "Cantiere"
Ws1.Cells(RR1, UC1).Value = Cantiere
End If
SaltaCC2:
Next CC2
End If
Next RR1
Next RR2
Workbooks(NFile).Close savechanges:=False
End Sub
Inoltre nel Vba del foglio "Riepilogo"
inserisci questo codice
- Codice: Seleziona tutto
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "B2:IV13"
If Target = "" Then Exit Sub
RigaR = Target.Row
If Not Application.Intersect(ActiveCell, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then GoTo SaltaAA
MeseR = Range("A" & RigaR).Value
CantiereR = Target.Value
NomeF = Name
Avvio
End If
SaltaAA:
End Sub
Aggiungi il comando tasto veloce Ctrl+m alla macro "Avvio"
ora hai queste possibilità:
1) Se ti trovi nel foglio Riepilogo, qualsiasi cella piena (con numero Cantiere) che viene selezionata avvierà la macro relativa al mese (corrispondenza col A) e compilerà il foglio mese con relativo cantiere selezionato
2) Sempre nel foglio Riepilogo, selezionando una cella vuota e premendo Ctrl+m si ricompilerà il foglio Riepilogo aggiornandolo
3) Premendo il comando Ctrl+m da qualsiasi altro foglio (mese) si potrà avere il resoconto del relativo mese in funzione del cantiere digitato nell'apposito box
Allego il file testCiao
EDIT: ci siamo accavallati con i post (intanto invio e aspetto riscontro del lavoro svolto e studierò anche il tuo file)