Ciao Mario, grazie per l'interessamento.
Allego i codici, non nella totalità altrimenti risulterebbero troppo lunghi, ho tolto le righe di trasferimento dati o passi puramente meccanici.
il primo codice da timeline a Lavori è:
Sub Auto_close()
'dichiaro le variabili
Dim wk1, wk2 As Workbook
Dim sh1, sh2 As Worksheet
Dim UltimaRigaTimeLine As Integer
Dim UltimaRigaLista As Integer
Dim t_TimeLine, t_Lista As Integer
Dim Code_TL, Code_Lista, pth_save, File_Save As String
Dim i As Date
'gestione errori
On Error GoTo RigaErrore
Application.ScreenUpdating = False
'metto i riferimenti ai files
Set wk1 = ThisWorkbook
Set wk2 = Workbooks.Open("\\................\Lavori.xlsx")
'metto i riferimenti ai fogli
Set sh1 = wk1.Worksheets("Dati")
Set sh2 = wk2.Worksheets("Sheet1")
UltimaRigaLista = sh2.Range("D5").End(xlDown).Row
UltimaRigaTimeLine = sh1.Range("B100").End(xlUp).Row
Code_TL = Left(sh1.Cells(3, 2), 4)
With sh2
……………………………………………(codice tolto)
End With
'chiudo il file lavori salvando
wk2.Close SaveChanges:=True
‘salvo il file timeline nella destinazione corretta
pth_save = "\\..................\Extra\"
File_Save = Left(sh1.Cells(3, 2).Value, 4) & "-TimeLineClient.xlsm"
‘ se la destinazione contiene già il file sovrascrive altrimenti lo crea
If Dir(pth_save & File_Save) <> vbNullString Then
wk1.Close SaveChanges:=True
Else
wk1.SaveAs Filename:=pth_save & File_Save, FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
On Error Resume Next
wk1.Close SaveChanges:=False
End If
Application.ScreenUpdating = True
'riga sempre eseguita
RigaChiusura:
'Set a Nothing delle variabili oggetto
Set sh2 = Nothing
Set sh1 = Nothing
Set wk1 = Nothing
Set wk2 = Nothing
Exit Sub
'in caso di errore
RigaErrore:
MsgBox Err.Number & vbNewLine & Err.Description
Resume RigaChiusura
End Sub
Il codice invece che dovrebbe copiarmi i dati sul cambiamento di un set di celle nel file "Timeline" e che poi speravo aggiornasse il file "Lavori" con il codice qui sopra è:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range
Dim wk1, wk4 As Workbook
Dim sh1, sh4 As Worksheet
Application.ScreenUpdating = False
Set KeyCells = Range("D5:D40")
If Not Application.Intersect(KeyCells, Range(Target.Address)) _
Is Nothing Then
Set wk1 = ThisWorkbook
Set sh1 = wk1.Worksheets("Ass_lavori_tecnici")
Set wk4 = Workbooks.Open("\\.......\"-TimeLineClient.xlsm")
Set sh4 = wk4.Worksheets("TimeLine")
sh4.Cells(20, 5).Value = sh1.Cells(Target.Row, 4).Value
wk4.Close SaveChanges:=True
End If
Application.ScreenUpdating = True
End Sub
Secondo me dipende dal metodo che uso per la chiusura del file ma non riesco a trovare la soluzione.
Mi scuso anche per i codici che magari non sono così professionali.
Grazie ancora ed attendo gradito riscontro.
Sandro