Private Sub Transfertdonnées_Click()
Dim wk As Workbook
Dim Lig As Long
Dim i As Byte
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'-------------------------------------------------------------------
' Ouverture du fichier
'-------------------------------------------------------------------
On Error Resume Next
Set wk = Workbooks("Synthèse.xls")
If Err > 0 Then
Err.Clear
Set wk = Workbooks.Open(ThisWorkbook.Path & "\Synthèse.xls")
End If
ThisWorkbook.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err.Number > 0 Then
MsgBox "Erreur lors de l'ouverture du fichier synthèse.xls", vbCritical, "Exportation"
Exit Sub
End If
'----------------------------------------------------------------------
' Transfert des données
'----------------------------------------------------------------------
On Error GoTo 0
Lig = wk.Sheets("Feuil1").Range("A21").End(xlUp).Row + 1
For i = 1 To 6
wk.Sheets("Feuil1").Cells(Lig, i) = Sheets("Trame").Range("C3,C5,I24,K24,I26,K26").Areas(i)(1)
Next i
'---------------------------------------------------------------------
' Fermeture du fichier synthèse
'---------------------------------------------------------------------
If Not Wk is nothing then
Wk.save
Wk.close
End if
End Sub