Discussion :

[FredPer]

Bonjour à tous,

j'ai un ptit soucis sur ma ligne [Set loInterv = ActiveSheet.ListObjects(1)]
--> 'Erreur d'exécution '9' ...

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
 
Sub recuperation()
 
'Déclarer les variables
 
Dim principal       As Workbook    'fichier récapitulatif
Dim recup           As Worksheet    'feuille récapitulative
Dim repertoire      As String    'dossier source
Dim source          As Workbook  'fichier source
Dim fichier         As String    'nom du fichier source
Dim VBA             As Worksheet    'feuille source
Dim loInterv        As ListObject
Dim lcInterv        As ListColumns
Dim lrI             As ListRow
 
    'Désactiver le rafraîchissement de l'écran avant la macro
 
    Application.ScreenUpdating = False
 
    'Ouvrir la feuille source du fichier source
 
    Set principal = ThisWorkbook
    repertoire = "D:\fiches_interventions_ST\fiches_inter" 'Modification nécessaire en cas de changement d'ordinateur
    Set loInterv = ActiveSheet.ListObjects(1)
    Set lcInterv = loInterv.ListColumns
    Set recup = principal.Worksheets("janv2019")
    dlr = recup.Cells(Rows.Count, "B").End(xlUp).Row    ' dernière ligne utilisée sur recup
    fichier = Dir(repertoire & "\*.xls")
    On Error GoTo Erreur
    While fichier <> ""
        If fichier <> principal.Name Then
            Workbooks.Open repertoire & "\" & fichier
            Set source = ActiveWorkbook
            Set VBA = ActiveWorkSheet
            Set lrI = Nothing
            On Error Resume Next
            Set lrI = loInterv.ListRows(lcInterv("fiches interventions").DataBodyRange.Find(fichier, LookIn:=xlValues, lookat:=xlWhole).Row - loInterv.HeaderRowRange.Row)
            On Error GoTo Erreur
            If lrI Is Nothing Then
                MsgBox "Fiche " & fichier & " non trouvée dans le tableau"
            Else
                Intersect(lrI.Range, lcInterv("CARSAT").DataBodyRange).Value = VBA.Range("B6").Value
                Intersect(lrI.Range, lcInterv("NIR").DataBodyRange).Value = VBA.Range("B10").Value
            End If
 
            source.Close False
        End If
        fichier = Dir()
    Wend
    Exit Sub
Erreur:
    MsgBox "un problème est survenu"
End Sub

Cette Macro a pour but de récupérer une donnée (B6, B10 ou autre ...) dans autre classeur et la positionner dans mon tableau récapitulatif.
L'ActiveSheet s'ouvre bien mais ensuite on passe à MsgBox "un problème est survenu"

Quelqu'un aurait une idée du problème ???
Merci d'avance