Problème d'incrémentation et de définition

Version imprimable

Bonjour,

J'ai un fichier excel avec des feuilles vertes et des feuilles jaunes. Il faudrait que les cellules tant des feuilles jaune (i) soit copiées/collées dans les cellules tant des feuilles verte (i).
Toutes les feuilles vertes sont à gauche et les feuilles jaunes à droite.

J'ai donc créé la macro suivante :

Code:

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
54
Sub Macro5()
 
Dim i, FJ, FV As Integer
FJ = 0
FV = 0
"FJ nombre de feuilles jaunes
"FV de feuilles vertes
 
Dim Current As Worksheet
For Each Current In Worksheets
Current.Activate
If Current.Tab.ColorIndex = 6 Or Current.Tab.ColorIndex = 27 Then
FJ = FJ + 1
End If
Next Current
 
For Each Current In Worksheets
Current.Activate
If Current.Tab.ColorIndex = 4 Then
FV = FV + 1
End If
Next Current
MsgBox FV
MsgBox FJ
 
'Compte + vérification
 
Dim Fverte() As String
ReDim Fverte(1 To FV)
For i = 1 To FV
    Fverte(i) = Worksheets(i).Name
Next i
Dim Fjaune() As String
ReDim Fjaune(FV + 1 To FV + FJ)
For i = FV + 1 To FV + FJ
    Fjaune(i) = Worksheets(i).Name
Next i
"donne un nom pour chaque feuille afin de réaliser l'opération suivante (de dire cellule tant de FJ(1) dans cellule tant de FV(1) etc...
 
For i = 1 To FV
    Sheets(Fjaune(i)).Range("O5").Copy
    Sheets(Fverte(i)).Range("C11").Select
    ActiveSheet.Paste
    Sheets(Fjaune(i)).Range("O6").Copy
    Sheets(Fverte(i)).Range("C9").Select
    ActiveSheet.Paste
    Sheets(Fjaune(i)).Range("L6").Copy
    Sheets(Fverte(i)).Range("C8").Select
    ActiveSheet.Paste
Next i
"Truc qui bug
 
 
End Sub

J'ai un problème ligne 41. Erreur 9 : l'indice n'appartient pas à la sélection.
Je ne vois pas comment faire... Peut-être ai-je mal définie mets noms de feuilles ?
Ou bien peut-être est-ce la ponctuation de la ligne en question...

28/02/2013, 17h13
Kimy_Ire
1) Déjà, ca serait beaucoup plus simple de faire :
Code:

1 2 3 Sheets(Fverte(i)).Range("C11") = Sheets(Fjaune(i)).Range("O5") Sheets(Fverte(i)).Range("C9") = Sheets(Fjaune(i)).Range("O6") Sheets(Fverte(i)).Range("C8") = Sheets(Fjaune(i)).Range("L6")
2) Met tout tes "Dim" au tout début de ta fonction.

3) Les commentaires sont avec le signe ' et pas " ;)

4) Test déjà avec ces changements ! :ccool:

EDIT : Attention, si FV et FJ n'ont pas la même taille tu vas avoir un problème...

Bonjour,

ton problème viens du fait que tu déclare deux tableaux (Fjaune et Fverte)

Fverte ne vas pas poser problème, sa sera Fjaune car tu l'initialise de la façon suivante :

Code:

ReDim Fjaune(FV + 1 To FV + FJ)

si 2 feuilles vertes et 2 feuilles jaunes tu auras:

Fjaune(3) et Fjaune(4) comme champs disponibles dans FJaune

Tu déclares de la façon suivante: et tu remplis bien FJaune(3) et Fjaune(4)
Code:

1 2 3 For i = FV + 1 To FV + FJ Fjaune(i) = Worksheets(i).Name Next i
mais par la suite, sa pêche: tu demandes:
Code:

1 2 3 4 5 6 7 8 9 10 11 For i = 1 To FV Sheets(Fjaune(i)).Range("O5").Copy Sheets(Fverte(i)).Range("C11").Select ActiveSheet.Paste Sheets(Fjaune(i)).Range("O6").Copy Sheets(Fverte(i)).Range("C9").Select ActiveSheet.Paste Sheets(Fjaune(i)).Range("L6").Copy Sheets(Fverte(i)).Range("C8").Select ActiveSheet.Paste Next i
Donc: tu commences par demande Fjaune(1), qui n'existe pas!!
voici ce qu'il faudrait mettre (enfin je pense... si FV et FJ n'ont pas la même taille, sa va planter quand même)
Code:

1 2 3 4 5 6 7 8 9 10 11 For i = 1 To FV Sheets(Fjaune(i + FV)).Range("O5").Copy Sheets(Fverte(i)).Range("C11").Select ActiveSheet.Paste Sheets(Fjaune(i + FV)).Range("O6").Copy Sheets(Fverte(i)).Range("C9").Select ActiveSheet.Paste Sheets(Fjaune(i + FV)).Range("L6").Copy Sheets(Fverte(i)).Range("C8").Select ActiveSheet.Paste Next i

Ho oui bien vu Supierre !

Bon du coup tu as raison et j'en conclus que c'est même inutile de définir feuilles jaunes et feuilles vertes et j'ai repris le code comme ceci :
Code:

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 Sub Macro5() Dim i, Nbr As Integer Nbr = 0 Dim Current As Worksheet For Each Current In Worksheets Current.Activate If Current.Tab.ColorIndex = 6 Or Current.Tab.ColorIndex = 27 Then Nbr = Nbr + 1 End If Next Current MsgBox Nbr Dim Feufeuille() As String ReDim Feufeuille(1 To 2 * Nbr) For i = 1 To 2 * Nbr Feufeuille(i) = Worksheets(i).Name Next For i = 1 To Nbr Sheets(Feufeuille(i)).Range("C11") = Sheets(Feufeuille(i + Nbr)).Range("O5") Sheets(Feufeuille(i)).Range("C9") = Sheets(Feufeuille(i + Nbr)).Range("O6") Sheets(Feufeuille(i)).Range("C8") = Sheets(Feufeuille(i + Nbr)).Range("L6") Next i End Sub
La macro se déroule bien, je n'ai pas de message d'erreur et ça marche sur environ 90% de mes feuilles (sur les autres il doit y avoir de la magie noire à l'intérieur) !
En tout cas merci beaucoup à tous les deux !

PS : oui y a toujours le même nombre de feuilles jaunes et vertes.