petite macro sur excel...

Version imprimable

12/12/2005, 10h04
manu13009

petite macro sur excel...

bonjour à ceux qui me liront et merci à ceux qui me répondront

ca fait des jours et des jours que je cherche à faire une macro sous excel. N'y arrivant pas avec les fonctions et les maco automatiques d'office je me suis attelé à étudier VBA pour programmer moi-même ma macro.
Ca fait une semaine et je n'y arrive pas comme je voudrais.
Si quelqu'un pouvait m'y aider soi en me donnat des indications soit en me donnat le code ca m'aiderait grandement.

J'explique :

La feuille 1 de mon classeur actif contient 220 lignes et 15 colonnes.
Les cellules de ma colonne E sont coloriées de différentes couleurs pour différencier leur type de contenu (je vous passe les détails) : j'ai donc 5 couleurs différentes pour les cellules de cette colonne.
Je voudrais créer d'autres feuilles dans ce classeur qui reprennent le contenu des cellules de la colonne E de ma feuille 1 mais chaque feuille me donnant le contenu des cellules de même couleur uniquement ainsi que le contenu de certaines autres colonnes de la même ligne.
Je ne veux pas avoir de lignes vides...
Comme dans ma colonne E feuille 1, j'ai 5 couleurs différentes, je voudrais donc créer 5 autres feuilles.

J'espere que j'ai été suffisemment clair.

Merci pour vos réponses. N'hésitez pas à me demander des précisions en cas d'incompréhension.
12/12/2005, 10h40
Igloobel

Tu dis que tu as commencer montre nous ce que tu as déjà fais !

Igloobel

tiens si cela te donne des idées...

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
Option Explicit
'
' Test existance feuille
'
Function FeuilleExiste(NomFeuille) As Boolean
 On Error GoTo err
  Debug.Print Sheets(NomFeuille).Name
 FeuilleExiste = True
 Exit Function
err:
  FeuilleExiste = False
End Function
'
' Nom Feuille
'Fonction à Compléter détermine le nom de la feuille en fonction de la
' couleur donnée en paramétre
'
Function NomFeuille(iColor As Long) As String
  Select Case iColor
     Case 16777215 ' Sur fond blanc
        NomFeuille = "Blanc"
     Case Else
        NomFeuille = "Couleur - " & iColor
   End Select
End Function
'
' VerifieFeuille
' Verifie existence feuille et la crée si n'existe pas
Sub VerifieFeuille(stNom As String)
 If Not FeuilleExiste(stNom) Then
    Sheets.Add
    ActiveSheet.Name = stNom
 End If
End Sub
'
' iProchaineLigne
'Determine Prochaine Ligne
'
'
Function iProchaineLigne(stNomFeuille, stNomCellule) As Integer
Dim i As Integer
i = Sheets(stNomFeuille).Cells(65535, Range(stNomCellule).Column).End(xlUp).Row
If Not (i = 1 And Sheets(stNomFeuille).Range(stNomCellule).EntireColumn.Cells(1) = "") Then
  i = i + 1 'Rajoute 1 à i sauf si 1° Cellule de la colonne et est vide..
End If
 
iProchaineLigne = i
 
 
 
End Function
 
 
' Macro de copie colonne E..
'
Sub MaMacro()
Dim rSource As Range ' Range Source de la copie
Dim c As Range
Dim st As String
Dim iL As Integer 'derniere ligne du fichier
Set rSource = Sheets("Feuil1").Range("E1:E220") ' A Adapter ...
For Each c In rSource
  If c.Value <> "" Then ' Ne traite que les cellules non-vides..
    Debug.Print c.Value
    st = NomFeuille(c.Interior.Color)
    VerifieFeuille (st)
    iL = iProchaineLigne(st, "E1")
    c.Parent.Activate 'Active.
    c.EntireRow.Copy
    Sheets(st).Activate
    Cells(iL, 1).Select
    ActiveSheet.Paste
 
  End If
Next
 
End Sub