XL 2016 50290 erreur définie par l'application ou par l'objet

[Marwa Chefii]

Bonjour à tous,

Je suis débutante en VBA et je rencontre un problème très gênant.

J'ai créé un bouton dans mon fichier EXCEL qui permet d'actualiser les données d'un onglet "SOURCE" à partir d'un autre fichier (voir code ci dessous).

Le code fonctionne parfaitement, sauf qu'une erreur aléatoire se produit [50290 erreur définie par l'application ou par l'objet] , et pointe sur la ligne en jaune dans la capture ci dessous.

Lors du débogage, je clique sur continuer et l'exécution du code reprenne normalement.

Any help please ! c'est un peut urgent

Sub Bouton_Actualiser()

    Application.ScreenUpdating = False
    
    Dim Var As String
    Sheets("PERSONNES PHYSIQUES").Select
    Var = Range("C7").Value
    
    Set XL = CreateObject("Excel.Application")
    XL.Visible = False
    XL.Application.DisplayAlerts = False
    XL.Application.AlertBeforeOverwriting = False
    XL.Workbooks.Open ("C:\tmp\SOURCE PPH.xls")
    XL.Sheets("SOURCE PPH").Activate
    XL.ActiveSheet.Range("A2").Copy
    
    Sheets("PERSONNES PHYSIQUES").Activate
    
    Déprotéger
    
    ActiveSheet.Range("C5").PasteSpecial Paste:=xlPasteValues
    ActiveSheet.Range("C7").Select
    Selection.Copy
    ActiveSheet.Range("C5").PasteSpecial Paste:=xlPasteFormats
    Application.CutCopyMode = False
    Selection.NumberFormat = "[$-fr-FR]mmm-yy;@"
    
    If ActiveSheet.Range("D5").Value = "NON" Then
    XL.Range("B1").Select
    XL.Selection.AutoFilter
    XL.ActiveSheet.Range("$A$1:$U" & XL.ActiveSheet.UsedRange.Rows.Count).AutoFilter Field:=2, Criteria1:=Var
    XL.ActiveSheet.Range("A2:U" & XL.ActiveSheet.UsedRange.Rows.Count).Copy
    Sheets("AGT85 SOURCE PPH").Select
    ActiveSheet.Range("A" & ActiveSheet.UsedRange.Rows.Count + 1).Select
    ActiveSheet.Paste
    ActiveSheet.Range("V2").Select
    Selection.AutoFill Destination:=Range("V2:V" & ActiveSheet.UsedRange.Rows.Count)
    
    Sheets("PERSONNES PHYSIQUES").Select
    
    ActiveSheet.AutoFilterMode = False
    
    Dim PL1 As Range
    Set PL1 = Application.Union(Range("E12:M" & ActiveSheet.UsedRange.Rows.Count), Range("T12:U" & ActiveSheet.UsedRange.Rows.Count), Range("W12:W" & ActiveSheet.UsedRange.Rows.Count))
    PL1.Locked = True
    
    Range("B11").Select
    Selection.AutoFilter
    ActiveSheet.Range("$B$11:$AD" & ActiveSheet.UsedRange.Rows.Count).AutoFilter Field:=1, Criteria1:="Actuelle"
    
    Dim PL As Range
    Set PL = Application.Union(Range("E12:M" & ActiveSheet.UsedRange.Rows.Count), Range("T12:U" & ActiveSheet.UsedRange.Rows.Count), Range("W12:W" & ActiveSheet.UsedRange.Rows.Count))
    PL.Locked = False
    
    ActiveSheet.Range("C5").Select
    
    Protéger

    MsgBox "FICHIER ACTUALISE AVEC SUCCES!"
    
    CutCopyMode = False
    
    XL.CutCopyMode = False
    XL.ActiveWorkbook.Close
    XL.Quit
    Set XL = Nothing
    
    Exit Sub
    
    Else:
    
    Protéger
    
    MsgBox "ATTENTION ... FICHIER DEJA ACTUALISE!"
    
    CutCopyMode = False
    
    XL.CutCopyMode = False
    XL.ActiveWorkbook.Close
    XL.Quit
    Set XL = Nothing
    
    Exit Sub
    
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[James007]

Bonjour,

Malheureusement, ta copie du code ne montre pas ... la ligne en jaune

 

[Marwa Chefii]

Bonjour James007,

ci joint la capture.

 

[job75]

Bonjour Marwa Chefii, James007,

Pour éviter le bug il suffit que dans le fichier "SOURCE PPH.xls" il y ait une feuille nommée "SOURCE PPH".

A+

 

[Marwa Chefii]

Bonjour Marwa Chefii, James007,

Pour éviter le bug il suffit que dans le fichier "SOURCE PPH.xls" il y ait une feuille nommée "SOURCE PPH".

A+

Bonjour job75,

c'est déja le cas !

 

[James007]

Re,

As-tu testé tes deux instructions sans XL.

Sheets("SOURCE PPH").Activate
ActiveSheet.Range("A2").Copy

En espèrant que cela t'aide

 

[Marwa Chefii]

Re,

As-tu testé tes deux instructions sans XL.

Sheets("SOURCE PPH").Activate
ActiveSheet.Range("A2").Copy

En espèrant que cela t'aide

Ça ne fonctionne pas, dans ce cas la macro cherche l'onglet "SOURCE PPH" dans le fichier contenant la macro et pas dans le fichier "SOURCE"

 

[Dranreb]

Bonjour.
Conseils: n'utilisez pas de deuxième instance d'Excel. N'utilisez pas non plus les Select et Selection. Utilisez à la place des variables déclarées As Workbook, As Worksheet et As Range.

 

[job75]

J'ai testé la macro avec 2 fichiers contenant les feuilles et les cellules adéquates et je n'ai pas eu de bug.

Pour savoir ce qui se passe chez vous il faudrait joindre vos fichiers, allégés et sans données confidentielles.

Salut Bernard.

 

[Dranreb]

Salut Job75.
Le début pourrait ressembler à ça :

Option Explicit
Sub Bouton_Actualiser()
   Dim ClasseurCible As Workbook, FeuilleCible As Worksheet, PlageCible As Range, _
       ClasseurSourc As Workbook, FeuilleSourc As Worksheet, PlageSourc As Range
   Application.ScreenUpdating = False
   Set ClasseurCible = ActiveWorkbook
   Set FeuilleCible = ClasseurCible.Worksheets("PERSONNES PHYSIQUES")
   Set ClasseurSourc = Workbooks.Open("C:\tmp\SOURCE PPH.xls")
   ClasseurCible.Activate
   Déprotéger
   Set FeuilleSourc = ClasseurSourc.Worksheets("SOURCE PPH")
   FeuilleCible.[C5].Value = FeuilleSourc.[A2].Value

 

[Marwa Chefii]

Salut Job75.
Le début pourrait ressembler à ça :

Option Explicit
Sub Bouton_Actualiser()
   Dim ClasseurCible As Workbook, FeuilleCible As Worksheet, PlageCible As Range, _
       ClasseurSourc As Workbook, FeuilleSourc As Worksheet, PlageSourc As Range
   Application.ScreenUpdating = False
   Set ClasseurCible = ActiveWorkbook
   Set FeuilleCible = ClasseurCible.Worksheets("PERSONNES PHYSIQUES")
   Set ClasseurSourc = Workbooks.Open("C:\tmp\SOURCE PPH.xls")
   ClasseurCible.Activate
   Déprotéger
   Set FeuilleSourc = ClasseurSourc.Worksheets("SOURCE PPH")
   FeuilleCible.[C5].Value = FeuilleSourc.[A2].Value

Bonjour Dranreb,

J'ai essayé d'adapter ma macro suivant tes conseils. A priori ça marche Pourvu que ça dure !

Merci infiniment.

Et je remercie tout le monde !

 

[Marwa Chefii]

Par contre j'ai un autre petit soucis !

Sur mon PC la macro fonctionne parfaitement. Mais quand j'essaye de l'exécuter sur d'autres PC ça Bug !

Avez vous une idée qu'est ce que ça peut être?

 

[job75]

Avez vous une idée qu'est ce que ça peut être?

D'après ce qu'on a vu vous débutez en VBA alors sûrement une erreur de débutant.