Comportement aléatoire de l'Excel

Bonjour le forum,

Je voudrais demander votre aide pour résoudre la situation suivante :

J’ai deux groups des fichiers qui se trouvent dans deux répertoires différents. Fichier 1 a une macro que renvoie des données vers le fichier 1A., fichier 2 vers 2A etc. En plus, les données de chaque fichier seront enregistrées dan le fichier "BD_consolidees.xls".

Le problème est que des fois j’obtiens un avertissement (prévu dans la macro) qui me dit « Le fichier 1A n’existe pas ». Dans ce cas là, j’ouvre manuellement le fichier 1A et je le ferme sans aucun changement. Je relance la macro et, quel merveille, tous fonctionne bien. Je ne sais toujours pas est-ce que c’est aléatoire ou il y a des « règles » de ce « comportement ». Au même temps, l'enregistrement dans le fichier "BD_consolidees.xls" se passe sans problème.

Notre « so called » SYSADMIN me dit que « Ces sont de bêtises de l’Excel ». Ca ni fixe ni resout le problème.

Est-ce que quelqu’un a dû résoudre des problèmes de ce type ?

Est-ce que un problème de la macro ? De l’Excel ? Du réseau ?

Merci pour vos idées !

P.S. J’utilise Excel 2011 pour MAC

Voilà le code :

    sub consolide()
    Dim WbkMaitre As Workbook, WbkConso As Workbook
    Dim nbLign As Long, derLign&, doublon&, i&, derLignC&, derLignA&
    Dim TblCde
    Dim repertoire As String
    Dim cel As Range, trouve As Range

    Application.ScreenUpdating = False
    'classeur maître : Fichier contenant le bon de commande
    Set WbkMaitre = ThisWorkbook
    repertoire = "Gestion:web:telechargement:" 'mettre le chemin du répertoire contenant les BD ici, laisser le ":" à la fin
    'If Left(CurDir, 1) <> Left(repertoire, 1) Then ChDrive Left(repertoire, 1) & ":": ChDir repertoire
    'classeur cible 1 : Fichier de commandes consolidées
    'ChDir repertoire
    'Workbooks.Open repertoire & "BD consolidées.xls"
    Workbooks.Open "gestion:Dépenses:BD_consolidees.xls", Updatelinks:=False
    Set WbkConso = ActiveWorkbook

With WbkMaitre.Sheets("Commande")
'compte le nombre de ligne de commande
nbLign = .Application.WorksheetFunction.Count(.Range("C:C"))

'si le nombre de ligne est nul on sort de la macro
If nbLign = 0 Then MsgBox "La commande ne comporte aucune ligne": Exit Sub
    Set TblCde = .[C3].Resize(nbLign, 25)
    End With
    With WbkConso
.Activate
With .Sheets("Data")
      derLign = .Range("C" & Rows.Count).End(xlUp).Row + 1
        .Range("C" & derLign).Resize(nbLign, 25).Value = TblCde.Value
        TblCde.Copy
        .Range("C" & derLign).PasteSpecial Paste:=xlPasteFormats
        Application.CutCopyMode = False
 'suppression des doublons
        For Each cel In .Range("C" & derLign).Resize(nbLign)
        doublon = Evaluate("SumProduct((" & .Range("C3:C" & derLign - 1).Address & "=" & cel.Value & ")*(" & .Range("D3:D" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
        If doublon > 0 Then Cells(cel.Row, 1).Value = "$$$"
            Next cel
                Set trouve = .Range("A" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
                If Not trouve Is Nothing Then
                For i = nbLign + derLign - 1 To derLign Step -1
                If .Cells(i, 1) = "$$$" Then .Rows(i).Delete
                Next i
            End If
        derLignC = .Range("C" & Rows.Count).End(xlUp).Row
        derLignA = IIf(.Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, .Range("A" & Rows.Count).End(xlUp).Row + 1)
        If derLignC > derLignA Then
        For i = derLignA To derLignC
 .Cells(i, 1) = .Cells(i - 1, 1) + 1
                 Next i
            End If
        End With
   '.Close
End With

        With WbkMaitre
            .Activate
            a = .Sheets("Commande").Range("c3").Resize(nbLign).Value
            lim = UBound(a)
        ReDim temp(1 To lim, 1 To 1)
            k = 1
            cpt = 0
                temp(1, 1) = a(1, 1)
        For i = 1 To lim
        For j = 1 To lim
    If a(i, 1) = temp(j, 1) Then Exit For
                cpt = cpt + 1
        Next j
    If cpt = lim Then k = k + 1: temp(k, 1) = a(i, 1)
     cpt = 0
        Next i
        For i = 1 To k
        Call Cde_Equip(WbkMaitre, .Sheets("Commande"), repertoire, temp(i, 1))
        Next i
    End With
    Call sauvegarde
    End Sub

Sub Cde_Equip(Maitre As Workbook, FeuilBase As Worksheet, ByVal rep As String, ByVal numEquip As Long)
Dim nbLign As Long, derLign&, i&, derLignA&, derLignC&
Dim trouve As Range, plageEquip As Range
FeuilBase.Copy before:=Maitre.Sheets(1)
With ActiveSheet
.Range("C3:AA45").Sort Key1:=.Range("C3"), Order1:=xlAscending, Key2:=.Range("D3") _
, Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom
nbLign = Application.CountIf(.Range("C3:C45"), numEquip)
Set trouve = .Range("C2:C45").Find(numEquip, LookIn:=xlValues, LookAt:=xlWhole)
Set plageEquip = trouve.Resize(nbLign, 25)
Set ExistFichier = Nothing
On Error Resume Next
Set ExistFichier = Workbooks.Open(repertoire & "BD_equipe_1.xlsm", Updatelinks:=False)
On Error GoTo 0
If ExistFichier Is Nothing Then
MsgBox "L'équipe " & numEquip & " n'a pas de fichier." & vbCrLf & _
"Veuillez en créer un.", vbExclamation
Exit Sub
End If

Sheets("Data").Select
plageEquip.Copy
derLign = IIf(Range("C" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("C" & Rows.Count).End(xlUp).Row + 1)
With Cells(derLign, 3)
.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End With
'suppression des doublons
Columns(3).Insert xlToRight
For Each cel In Range("D" & derLign).Resize(nbLign)
doublon = Evaluate("SumProduct((" & Range("D3:D" & derLign - 1).Address & "=" & cel.Value & ")*(" & Range("E3:E" & derLign - 1).Address & "=" & cel.Offset(, 1).Value & "))")
If doublon > 0 Then Cells(cel.Row, 3).Value = "$$$"
Next cel
Set trouve = Range("C" & derLign).Resize(nbLign).Find("$$$", LookAt:=xlWhole)
If Not trouve Is Nothing Then
For i = nbLign + derLign - 1 To derLign Step -1
If Cells(i, 3) = "$$$" Then Rows(i).Delete
Next i
End If
Columns(3).Delete
derLignC = Range("C" & Rows.Count).End(xlUp).Row
derLignA = IIf(Range("A" & Rows.Count).End(xlUp).Row + 1 < 3, 3, Range("A" & Rows.Count).End(xlUp).Row + 1)
If derLignC > derLignA Then
For i = derLignA To derLignC
Cells(i, 1) = Cells(i - 1, 1) + 1
Next i
End If
Application.DisplayAlerts = False
.Delete
End With
End Sub

Bonjour le forum,

J'ai remplacé l'adresse relative

repertoire = "Gestion:web:telechargement:"
......
Set ExistFichier = Workbooks.Open(repertoire & "BD_equipe_1.xlsm", Updatelinks:=False)

par l'adresse exacte du fichier

Set ExistFichier = Workbooks.Open("Gestion:web:telechargement:BD_equipe_1.xlsm", Updatelinks:=False)

et le problème "s'est résolu".

Bonne journée à toutes et tous,

Baton