Bonjour le forum,
Je rencontre un problème lorsque j'appuie sur le bouton de transfert de données dans mon fichier, l'erreur d'exécution '-2147221080 (800401a8)' Erreur Automation apparaît.
Je sait que le problème vient de mon code mais je ne sais pas d'où exactement. J'utilise le code suivant :
Il est très long mais l'erreur vient au début, je pense. Quand j'ouvre Microsoft Visual Basic, la macro marche a merveille.
Quelqu'un peut-il me dire d'où vient l'erreur ?
Merci d'avance et bonne journée
Je rencontre un problème lorsque j'appuie sur le bouton de transfert de données dans mon fichier, l'erreur d'exécution '-2147221080 (800401a8)' Erreur Automation apparaît.
Je sait que le problème vient de mon code mais je ne sais pas d'où exactement. J'utilise le code suivant :
Code:
Private Sub Transfertdonnées_Click()
Dim wk As Workbook
Dim Plage As Range, c As Range
Dim Lig As Long
Dim i As Byte
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
Set wk = Workbooks("SYNTHESE.xls")
If Err > 0 Then
Err.Clear
Set wk = Workbooks.Open(ThisWorkbook.Path & "\SYNTHESE.xls")
End If
ThisWorkbook.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err.Number > 0 Then
MsgBox "Erreur lors de l'ouverture du fichier SYNTHESE.xls", vbCritical, "Exportation"
Exit Sub
End If
On Error GoTo 0
Lig = wk.Sheets("Secteur").Range("A500").End(xlUp).Row + 1
For i = 1 To 4
wk.Sheets("Secteur").Cells(Lig, i + 3) = Sheets("Trame").Range("J24,L24,L26,J26").Areas(i)(1)
Next i
On Error GoTo 0
Lig = wk.Sheets("Secteur").Range("A500").End(xlUp).Row + 1
For i = 1 To 2
wk.Sheets("Secteur").Cells(Lig, i) = Sheets("Trame").Range("D3,D5").Areas(i)(1)
Next i
If Not wk Is Nothing Then
wk.Save
wk.Close
End If
On Error Resume Next
Set wk = Workbooks("SUIVI.xls")
If Err > 0 Then
Err.Clear
Set wk = Workbooks.Open(ThisWorkbook.Path & "\SUIVI.xls")
End If
ThisWorkbook.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err.Number > 0 Then
MsgBox "Erreur lors de l'ouverture du fichier SUIVI.xls", vbCritical, "Exportation"
Exit Sub
End If
On Error GoTo 0
Set Plage = Sheets("Trame").Range("E11:E20")
For Each c In Plage
If UCase(c.Text) = "X" Then
With wk.Sheets("Suivi")
Lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & Lig) = Sheets("Trame").Range("D3")
.Range("B" & Lig) = Sheets("Trame").Range("D5")
.Range("C" & Lig) = Sheets("Trame").Range("B" & c.Row)
.Range("D" & Lig) = Sheets("Trame").Range("F" & c.Row)
.Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
.Range("F" & Lig) = Sheets("Trame").Range("J" & c.Row)
.Range("G" & Lig) = Sheets("Trame").Range("K" & c.Row)
.Range("H" & Lig) = .Range("A" & Lig) = Sheets("Trame").Range("D3") + .Range("E" & Lig) = Sheets("Trame").Range("I" & c.Row)
End With
End If
Next c
If Not wk Is Nothing Then
wk.Save
End If
On Error Resume Next
Set wk = Workbooks("HIPO.xls")
If Err > 0 Then
Err.Clear
Set wk = Workbooks.Open(ThisWorkbook.Path & "\HIPO.xls")
End If
ThisWorkbook.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
If Err.Number > 0 Then
MsgBox "Erreur lors de l'ouverture du fichier HIPO.xls", vbCritical, "Exportation"
Exit Sub
End If
On Error GoTo 0
Set Plage = Sheets("Trame").Range("M11:M20")
For Each c In Plage
If UCase(c.Text) = "VRAI" Then
With wk.Sheets("suivi")
Lig = .Range("A" & .Rows.Count).End(xlUp).Row + 1
.Range("A" & Lig) = Sheets("Trame").Range("D3")
.Range("B" & Lig) = Sheets("Trame").Range("D5")
.Range("C" & Lig) = Sheets("Trame").Range("B" & c.Row)
.Range("D" & Lig) = Sheets("Trame").Range("F" & c.Row)
.Range("E" & Lig) = Sheets("Trame").Range("J" & c.Row)
End With
End If
Next c
If Not wk Is Nothing Then
wk.Save
wk.Close
End If
End Sub
Il est très long mais l'erreur vient au début, je pense. Quand j'ouvre Microsoft Visual Basic, la macro marche a merveille.
Quelqu'un peut-il me dire d'où vient l'erreur ?
Merci d'avance et bonne journée