Bonjour à tous,

Je vous contacte car j'utilise une macro pour scinder mon onglet principal en plusieurs onglets à partir d'une colonne.
La macro fonctionne bien.

Le problème est que le fichier marche sur 2 postes et non sur 4.

Le message d'erreur est "mémoire insuffisante".

Le problème est que je ne sais pas si celka provient de la macro ci-dessous ou du poste informatique sur lequel cela tourne.

Je vous remercie d'avance pour vos retours.

@+

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
 
 
Public Sub EclatementActivité()
 
Dim maxLine_Onglet_Principal As Long
'A65536
Sheets("Onglet_Principal").Select
maxLine_Onglet_Principal = Range("A1999").End(xlUp).Row
Set RefActivité = Rows(1).Find(what:="Activité")
If RefActivité Is Nothing Then
    Exit Sub
Else
    RefNumColActivité = Range(RefActivité.Address).Column
    RefColActivité = Split(RefActivité.Address, "$")(1)
End If
 
'Créaton d'un dictionnaire (Récupération des différentes villes)
Set Dico = CreateObject("scripting.dictionary")
For Each Cellule In Sheets("Onglet_Principal").Range(RefColActivité & 2 & ":" & RefColActivité & maxLine_Onglet_Principal)
    If Cellule.Value = "" Then
        RefKey = "Aucune Activité"
        RefItem = Cellule.Value
        If Not Dico.exists(RefKey) Then
            Dico.Add RefKey, RefItem
        End If
    Else
        ListeActivité = Split(Trim(Cellule.Value), ";")
        For i = LBound(ListeActivité) To UBound(ListeActivité)
            RefKey = CStr(ListeActivité(i))
            RefItem = CStr(ListeActivité(i))
            If Not Dico.exists(RefKey) Then
                Dico.Add RefKey, RefItem
            End If
        Next i
    End If
Next
 
'Tri du dictionnaire en mode descending
RefKey = Dico.keys
RefItem = Dico.items
For n = LBound(RefKey) To UBound(RefKey)
  For m = LBound(RefKey) To UBound(RefKey)
    If RefKey(m) < RefKey(n) Then
      TempKey = RefKey(m)
      TempItem = RefItem(m)
      RefKey(m) = RefKey(n)
      RefItem(m) = RefItem(n)
      RefKey(n) = TempKey
      RefItem(n) = TempItem
    End If
  Next m
Next n
 
'Pour chaque Activité, création d'un nouvel onglet et récupération des données
For n = 0 To Dico.Count - 1
    Sheets("Onglet_Principal").Select
    CritFilter = RefItem(n)
    If RefKey(n) = "Aucune Activité" Then
        Selection.AutoFilter Field:=RefNumColActivité, Criteria1:=""
        ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).Copy
        Set New_Sheet = Sheets.Add(Before:=Sheets("Onglet_Principal"))
    Else
        Selection.AutoFilter Field:=RefNumColActivité, Criteria1:="*" & CritFilter & "*"
        ActiveSheet.Cells.SpecialCells(xlCellTypeVisible).Copy
        Set New_Sheet = Sheets.Add(Before:=Sheets(1))
    End If
    New_Sheet.Name = RefKey(n)
    ActiveSheet.Paste
    Rows(1).AutoFilter
    Range("A1").Select
Next n
 
With Sheets("Onglet_Principal")
    If .FilterMode = True Then
        .ShowAllData
    End If
Range("A1").Select
End With
 
End Sub