Bonjour,

Voici une macro qui appelle une fonction (les deux ci-dessous). Cette macro fonctionne pour la feuille 3:
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
Private Sub Workbook_Open()
 
Application.DisplayAlerts = False
 
    Const FileSource As String = "Sport"
 
    Dim wkbSrce As Workbook
    Dim last As Long
    Dim FoldersSource As Variant
    Dim subfolder As String
    'Dim x As Integer
    'Dim y As Integer
 
    'y = ThisWorkbook.Worksheets.Count
 
    'For x = 2 To y
 
        'subfolder = ThisWorkbook.Worksheets(x).Name
        subfolder = ThisWorkbook.Worksheets(3).Name
 
        If subfolder Like "STR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\TV\", "C:\Users\105063782\Desktop\Réseau test\TDSA\TV\")
        End If
        If subfolder Like "SCR####" Then
            FoldersSource = Array("C:\Users\105063782\Desktop\Réseau test\TDSK\CC\", "C:\Users\105063782\Desktop\Réseau test\TDSA\CC\")
        End If
 
        If Not IsEmpty(FoldersSource) Then
            Dim di As Integer
            For di = 0 To UBound(FoldersSource)
                If (ChercheEtOuvreFichierDepuis2(CStr(FoldersSource(di)) & subfolder & "\" & FileSource & ".xlsx", subfolder)) Then
                    Exit For
                End If
            Next di
        End If
 
    'Next x
 
End Sub
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
 
Private Function ChercheEtOuvreFichierDepuis2(fichier As String, subfolder As String) As Boolean
 
    Dim wkbSrce As Workbook
    Dim last As Integer
    Dim FoundFile As String
    Dim x As Integer
 
    ChercheEtOuvreFichierDepuis = False
 
    FoundFile = Dir(fichier)
 
    Do While FoundFile <> ""
 
        If FoundFile <> "" Then
 
            Application.ScreenUpdating = False
 
            Set wkbSrce = Application.Workbooks.Open(fichier)
 
            'wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(x)
            wkbSrce.Sheets(1).Copy after:=ThisWorkbook.Worksheets(3)
 
            'ThisWorkbook.Worksheets(x).Delete
            ThisWorkbook.Worksheets(3).Delete
 
            'ThisWorkbook.Worksheets(x).Name = subfolder
            ThisWorkbook.Worksheets(3).Name = subfolder
 
            wkbSrce.Close
 
            Set wkbSrce = Nothing
 
            Application.ScreenUpdating = True
            ChercheEtOuvreFichierDepuis = True
 
            Exit Do
 
        End If
 
        FoundFile = Dir
 
    Loop
 
End Function
Mais voila, je voudrais que ce qui se passe pour la feuille 3 se passe pour toutes mes feuilles sauf la 1. Jai donc rajouter à ce code des lignes (celles que vous voyez à présent en commentaires) et supprimer les lignes 19, 61, 64 et 67.
Et j'ai une "Erreur d'exécution '9': L'indice n'appartient pas à la sélection" qui apparait sans surligner aucun caractère du code.
Si ça peut aider le fichier appelé par le nom de la première feuille s'ouvre et ne se referme pas, je pense donc que le code bug entre les lignes 58 et 69 dans le première boucle.

Si vous avez une idée de pourquoi cette erreur dans ce code, je suis tout ouïe.

Merci.

Thomas