Erreur d'exécution 9
Bonjour,
Voici mon problème :
J'ai un code qui fonctionnait parfaitement pour un fichier test, et lorsque je le transpose dans le fichier finale en modifiant les noms de feuilles qui sont les seules à changer le code me pose l'erreur d'exécution 9 et je n'arrive pas à y remédier. Pourtant mes tableaux sont identiques.
Voici le code en question :
Dim Ws As Worksheet
Sub Relance()
Dim a(), i As Long, L As Long, cel As Range
' ReglerNon Macro
' Trie l'échéancier selon que régler = Non
Feuil13.Range("A8:B200").ClearContents 'feuil13 codename de feuille Relance
For Each Ws In Worksheets
If IsNumeric(Left(Ws.Name, 2)) Then
L = Ws.Range("A65000").End(xlUp).Row
If L > 7 Then
For Each cel In Ws.Range("G8:G" & L)
If cel = "Non" Then
i = i + 1: ReDim Preserve a(1 To 8, 1 To i) '
a(1, i) = cel.Offset(, -2) 'n°client
a(2, i) = cel.Offset(, -1) 'raison
a(6, i) = cel.Offset(, -6) 'Fact
a(7, i) = CDbl(cel.Offset(, -5)) 'date facture
a(8, i) = cel.Offset(, -3) 'montant
End If
Next
End If
End If
Next
a = Application.Transpose(a)
Feuil13.Range("A8").Resize(UBound(a, 1), UBound(a, 2)) = a
Feuil13.Columns("A:H").AutoFit
Set Ws = Worksheets("Relance")
DerL = Ws.Range("A65000").End(xlUp).Row
For L = 8 To DerL
Ws.Range("D" & L).FormulaLocal = "=SIERREUR(INDEX('BDD Client'!$A$2:$G$5;EQUIV($A" & L & ";'BDD Client'!$A$2:$A$5;0);6);"""")"
Ws.Range("E" & L).FormulaLocal = "=SIERREUR(INDEX('BDD Client'!$A$2:$G$5;EQUIV($A" & L & ";'BDD Client'!$A$2:$A$5;0);7);"""")"
Ws.Range("C" & L).FormulaLocal = "=SIERREUR(INDEX('BDD Client'!$A$2:$H$5;EQUIV($A" & L & ";'BDD Client'!$A$2:$A$5;0);8);"""")"
Next
Feuil13.Columns("A:H").AutoFit
'Permet de trier Relance selon le numéro client'
ActiveWorkbook.Worksheets("Relance").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Relance").Sort.SortFields.Add Key:=Range("A8:A200"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Relance").Sort
.SetRange Range("A7:H200")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
L'erreur d'exécution ce déclenche ici :
Feuil13.Range("A8").Resize(UBound(a, 1), UBound(a, 2)) = a
Le code d'origine était le suivant :
Sub RelanceTEST()
Dim a(), i As Long, L As Long, cel As Range
' ReglerNon Macro
' Trie l'échéancier selon que régler = Non
Feuil10.Range("A8:B200").ClearContents 'feuil10 codename de feuille RelaceEntête
For Each Ws In Worksheets
If IsNumeric(Left(Ws.Name, 2)) Then
L = Ws.Range("A65000").End(xlUp).Row
If L > 7 Then
For Each cel In Ws.Range("G8:G" & L)
If cel = "Non" Then
i = i + 1: ReDim Preserve a(1 To 8, 1 To i) '
a(1, i) = cel.Offset(, -2) 'n°client
a(2, i) = cel.Offset(, -1) 'raison
a(6, i) = cel.Offset(, -6) 'Fact
a(7, i) = CDbl(cel.Offset(, -5)) 'date facture
a(8, i) = cel.Offset(, -3) 'montant
End If
Next
End If
End If
Next
a = Application.Transpose(a) 'a colonnes,lignes devient a lignes,colonnes
Feuil10.Range("A8").Resize(UBound(a, 1), UBound(a, 2)) = a
Feuil10.Columns("A:H").AutoFit
Set Ws = Worksheets("RelanceEntête")
DerL = Ws.Range("A65000").End(xlUp).Row
For L = 8 To DerL
Ws.Range("C" & L).FormulaLocal = "=SIERREUR(INDEX('BDD Client'!$A$2:$G$5;EQUIV($A" & L & ";'BDD Client'!$A$2:$A$5;0);6);"""")"
Ws.Range("D" & L).FormulaLocal = "=SIERREUR(INDEX('BDD Client'!$A$2:$G$5;EQUIV($A" & L & ";'BDD Client'!$A$2:$A$5;0);7);"""")"
Ws.Range("E" & L).FormulaLocal = "=SIERREUR(INDEX('BDD Client'!$A$2:$H$5;EQUIV($A" & L & ";'BDD Client'!$A$2:$A$5;0);8);"""")"
Next
Feuil10.Columns("A:H").AutoFit
'Permet de trier RelanceEntête selon le numéro client'
ActiveWorkbook.Worksheets("RelanceEntête").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("RelanceEntête").Sort.SortFields.Add Key:=Range("A8:A125"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("RelanceEntête").Sort
.SetRange Range("A7:H125")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
En vous remerciant d'avance pour l'aide que vous pouvez m'apporter.
Cordialement, Masako
Bonjour
sans fichier test difficile....
mais perso j'aurais remplacé ceci
a = Application.Transpose(a)
Feuil13.Range("A8").Resize(UBound(a, 1), UBound(a, 2)) = a
par
Feuil13.Range("A8").Resize(UBound(a, 2), UBound(a, 1)) = Application.Transpose(a)
la feuil13 existe bien ?
quelles sont les dimensions du tableau a ??
fred
Bonjour fred2406,
J'aurais voulu un fichier l'inconvénient c'est que sur mon fichier test cela fonctionne et c'est sur l'originale que sa pause problème malheureusement il comporte la Base de données et sans la base de données on peut pas vérifier le fonctionnement,
en tout cas j'ai changé les lignes comme tu me l'as indiquées et cela fonctionne parfaitement, merci à toi
Masako
Dans ce cas..
merci
fred