Discussion :

[ouskel'n'or]

Effectivement, j'utiliserais mod.
Et pour l'utilisation de mod, un coup d'oeil dans l'aide en ligne
Bonne journée

[P96O1004]

Je viens de trouver un truc simple :
t = 0
t = t+1 chaque fois éxécuter
if t = 30 then sauvegarder et remettre t = 0

c'est pour éviter d'utiliser Mod.

Au final, j'ai ajouté ce code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
      If Number = 30 Then
        Number = 0
        ThisWorkbook.Save
      End If

mais ça ne marche pas

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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Sub collect()
Dim wsT As Worksheet
   Dim wsF As Worksheet
   Dim sFolderName, sFname, wName, tempName, As String
   Dim sFname As String
   Dim wName As String
   Dim tempName As String
   Dim Number As Integer
   Dim folderaddress$
 
 
Sheets("Update").Protect "haigiap"
ActiveWorkbook.Unprotect "haigiap"
 
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
 
 
For Each Feuille In Worksheets
    If (Feuille.Name <> "Update") Then
       Feuille.Delete
    End If
Next
 
'Application.DisplayAlerts = True
 
folderaddress = "Please insert address of your folder without '\' at the end"
wName = ThisWorkbook.Name
sFolderName = InputBox(folderaddress, "Insert Address BOX")
sFolderName = sFolderName & "\"
 
If sFolderName = "\" Then
    ActiveWorkbook.Protect "haigiap"
    Exit Sub
End If
'Récupérer des fichiers excels
 
sFname = Dir(sFolderName & "j*.xls")
 
If sFname = vbNullString Then
   MsgBox "No .xls Files In" _
      & Chr(10) & Chr(10) _
      & sFolderName, vbInformation
   Exit Sub
End If
 
Application.ScreenUpdating = False
Set wsT = ThisWorkbook.Sheets("Update")
Number = 0
 
   Do Until sFname = vbNullString
      Number = Number + 1
 
      'si number = 30 on sauvegarder le Workbook
      If Number = 30 Then
        Number = 0
        ThisWorkbook.Save
      End If
 
      tempName = Mid(sFname, 1, InStr(1, sFname, ".", vbBinaryCompare) - 1)
      If SheetExists(tempName) = True Then
        Application.DisplayAlerts = False
        Sheets(tempName).Delete 'supprimer les feuilles existantes
      End If
 
'récupérer la feuille global vision
      Workbooks.Open sFolderName & sFname
      Set wsF = Sheets("Global vision")
      wsF.Copy after:=wsT
      Set temp = Workbooks(wName).Sheets("Global vision")
      temp.Name = tempName
      Workbooks(sFname).Close True
      sFname = Dir
   Loop
 
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic
ActiveWorkbook.Protect "haigiap"
 
End Sub
 
Function SheetExists(SName As String, _
                     Optional ByVal WB As Workbook) As Boolean
    On Error Resume Next
    If WB Is Nothing Then Set WB = ThisWorkbook
    SheetExists = CBool(Len(Sheets(SName).Name))
End Function

Il affiche une erreur :
"Erreur d'exécution 1004. Nombre de formats de cellule différents trop élevé".
Voire que la feuille Global vision contient trop de vba code, je ne sais pas si on peut copier seulement la feuille sans le code.

[P96O1004]

Bon, c'est une question classique.
Google répond bien que c'est la limite de Excel.
Maintenant je débrouille pour faire un macro qui supprimer des formats personnalisés dans Outil-Format de cellule-Nombre-Personnalisé, en espérant que ça marche.