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 : Sélectionner tout - Visualiser dans une fenêtre à part
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