A
Sub Macro1()
Const Nf As String = 'Dernier pointage historisé' 'définit la constante Nf
Const PC As String = 'Pointage en cours' 'définit la constante PC
Dim chemO As String 'déclare la variable ChemO
Dim chemC As String 'déclare la variable chemC
Dim ws As Worksheet 'déclare la variable ws
Dim nom As String 'déclare la variable nom
chemO = ThisWorkbook.FullName 'définit la variable chemO
chemC = Sheets('Param').Range('C12').Value 'définit la variable chemC
nom = Sheets('param').Range('G10').Value & '.xls' 'définit la variable nom
Application.DisplayAlerts = False 'empêche les messages d'alerte d'excel
Sheets(Nf).Delete 'supprime la feuille 'Dernier pointage historisé'
Application.DisplayAlerts = True 'repermet les message d'alerte d'excel
'copie la feuille 'Pointage en cours'
Sheets(PC).Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = Nf 'renomme la copie en 'Dernier pointage historisé'
'supprime le bouton
ActiveSheet.Shapes('Button 1').Select
Selection.Delete
'remplace les formules par les résultats
ActiveSheet.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range('A1').Select
'efface les données de l'onglets 'Pointage en Cours'
Sheets(PC).Range('C4,C9:G11').ClearContents
ThisWorkbook.Save 'sauve le classeur
ThisWorkbook.SaveAs (chemC) 'crée la copie
Application.DisplayAlerts = False 'empêche les messages d'alerte d'excel
'supprime les onglets en trop de la copie
For Each ws In ActiveWorkbook.Sheets
If ws.Name <> Nf Then ws.Delete
Next ws
Application.DisplayAlerts = True 'repermet les message d'alerte d'excel
ThisWorkbook.Save 'sauve la copie
Application.Workbooks.Open (chemO) 'ouvre l'original
Sheets(PC).Select
Application.Workbooks(nom).Close 'ferme la copie
End Sub
[file name=Exemple3_20051031015108.zip size=14982]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Exemple3_20051031015108.zip[/file]Sub Macro1()
Dim Ori As Workbook 'déclare la variable Ori
Dim His As Workbook 'déclare la variable His
Const DPH As String = 'Dernier pointage historisé' 'définit la constante DPH
Const PeC As String = 'Pointage en cours' 'définit la constante PeC
Dim chemOri As String 'déclare la variable ChemOri
Dim chemHis As String 'déclare la variable chemHis
Dim ws As Worksheet 'déclare la variable ws
Set Ori = ThisWorkbook 'définit la variable Ori
chemOri = Ori.FullName 'définit la variable chemOri
chemHis = Sheets('Param').Range('C12').Value 'définit la variable chemC
With Ori
Application.DisplayAlerts = False 'empêche les messages d'alerte d'excel
.Sheets(DPH).Delete 'supprime la feuille 'Dernier pointage historisé'
Application.DisplayAlerts = True 'repermet les message d'alerte d'excel
'copie la feuille 'Pointage en cours'
.Sheets(PeC).Copy after:=Sheets(Sheets.Count)
.ActiveSheet.Name = DPH 'renomme la copie en 'Dernier pointage historisé'
'supprime le bouton
.ActiveSheet.Shapes('Button 1').Select
Selection.Delete
'remplace les formules par les résultats
.ActiveSheet.Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range('A1').Select
'efface les données de l'onglets 'Pointage en Cours'
.Sheets(PeC).Range('C4,C9:G11').ClearContents
.Save 'sauve le classeur
End With
Application.Workbooks.Open (chemHis) 'ouvre le classeur 'Historique.xls'
Set His = ActiveWorkbook 'définit la variable his
'copie l'onglet 'Dernier pointage historisé' dans le classeur 'Historique.xls'
Ori.Sheets(DPH).Copy after:=His.Sheets(Sheets.Count)
On Error Resume Next 'évite le bug si C4 est vide
ActiveSheet.Name = Range('C4').Value 'donne le nom à l'onglet en fonction de la cellule C4
His.Save 'sauve 'Historique.xls'
His.Close 'ferme 'Historique.xls'
Sheets(PeC).Select 'sélectionne l'onglet 'pointage en cours'
End Sub