Création et modification de fichier excel
Bonjour,
je dois faire une macro qui permet de créer d'autres fichiers excel et de les modifier en fonction d'une case que je check grâce à une boucle.
la modification se fait a partir d'un fichier source ( qui ne change jamais).
voici mon code :
Code:
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
72
73
74
|
Sub centredecout()
Dim WBSource As Workbook, WBDest As Workbook
Dim file_exist As String
Dim path As String, file As String, check_cell As String, new_file As String
Dim j As Long, i As Long, k As Long, last_row As Long, empty_last_row As Long
file = ActiveWorkbook.Name 'nom du fichier en cours : testmacro ici
last_row = Worksheets(1).Range("A65536").End(xlUp).Row 'dernière ligne du fichier en cours
Set WBSource = Workbooks(file) 'workbook source pour le c/c de ligne
'path = "C:\Documents and Settings\*****\Desktop\testmacro\" ''chemin du dossier pour créer les fichier
path = CurDir
Set WBSource = Workbooks(file)
For j = 5 To 10 'balayage des centre de coût
check_cell = WBSource.Sheets("Feuil1").Range("AM" & j).Value 'selection de la cellule colonne AM et ligne j
file_exist = Dir(path & check_cell & ".xls")
If file_exist = "" Then 'si le fichier n'existe pas, on en créé un nouveau
new_file = path & check_cell
Dim XLApp As New Excel.Application
Dim XLBook As Workbook
Dim XLSheet As Worksheet
Set XLBook = XLApp.Workbooks.Add
Set XLSheet = XLBook.Worksheets.Add
XLBook.SaveAs new_file
Set XLBook = XLApp.Workbooks.Open(new_file)
XLBook.Sheets("Feuil3").Delete
XLBook.Sheets("Feuil4").Delete
XLBook.Save
SetAttr new_file & ".xls", vbNormal
Set WBDest = Workbooks.Open(new_file)
'on met en place le fichier de destination
SetAttr new_file & ".xls", vbNormal
WBSource.Worksheets(1).Rows(3).Copy _
Destination:=WBDest.Worksheets(1).Cells(1, 1) 'c/c de l'entête du tableau
empty_last_row = WBDest.Worksheets(1).Range("A65536").End(xlUp).Row + 1 'on selectionne la dernière ligne vide
WBSource.Worksheets(1).Rows(4).Copy _
Destination:=WBDest.Worksheets(1).Cells(empty_last_row, 1)
WBDest.Save
WBDest.Close 'on le ferme
Else
file = path & check_cell & ".xls"
SetAttr file, vbNormal
Set WBDest = Workbooks.Open(file) 'on met en place le fichier de destination
empty_last_row = WBDest.Worksheets(1).Range("A65536").End(xlUp).Row + 1 'on selectionne la dernière ligne vide
WBSource.Worksheets(1).Rows(j).Copy _
Destination:=WBDest.Worksheets(1).Cells(empty_last_row, 1) 'c/c
ActiveWorkbook.Saved = True
WBDest.Close 'on le ferme
End If
Next j
End Sub |
Le problème est le suivant : mes fichiers se créent correctement mais les modifications ne se font pas.
La macro suit sont cours mais les fichiers obtenus sont vides.
(la boucle j est délibérement mise à 10 pour mes tests)
D'avance merci,
talk
