1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71
|
Option Explicit
Const MyFile_Modele = "C:\M.xls"
Const MyFile_Charge = "C:\C.xls"
Const ForReading = 1, ForWriting = 2, ForAppending = 8
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Dim objFso, objFile_Modele, objFile_Charge
Set objFso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set objFile_Modele = objFso.OpenTextFile(MyFile_Modele, ForAppending, TristateFalse)
Set objFile_Charge = objFso.OpenTextFile(MyFile_Charge, ForAppending, TristateFalse)
If Err.Number <> 0 Then
Msgbox "Le fichier est deja ouvert"&vbCrLf& Err.Number &vbCrLf& _
Err.Source &vbCrLf& Err.Description : Err.Clear
Else
objFile_Modele.Close
objFile_Charge.Close
Dim xlApp, xlBook_Modele, xlSheet_Modele,xlBook_Charge, xlSheet_Charge
Set xlApp = CreateObject("Excel.Application")
Set xlBook_Modele = xlApp.WorkBooks.Open(MyFile_Modele)
Set xlBook_Charge = xlApp.WorkBooks.Open(MyFile_Charge)
xlApp.DisplayAlerts = False
xlApp.Application.Visible=True
xlBook_Modele.Sheets("Feuil1").Range("A10:L65536").ClearContents 'Effacer les donnees dans le fichier source
xlBook_Charge.Activate
xlBook_Charge.Sheets("Feuil1").Range("A2:L65536").Select 'Copier les donnees dans le fichier source
Selection.Copy
xlBook_Modele.Activate
xlBook_Modele.Sheets("Feuil1").Range("A10:L65536").Select 'Coller les donnees dans le fichier cible
Selection.Paste
xlBook_Modele.Save 'Sauvegarder les donnees dans le fichier cible
xlApp.Quit
Set xlSheet = Nothing
Set xlApp = Nothing
Set xlBook = Nothing
End If
Set objFile = Nothing
Set objFso = Nothing |
Partager