Sub a()
Dim c As Range
For Each c In Selection
c.Offset(, 1) = c.Style
Next c
End Sub
Sub a()
Dim c As Range, i As Long, t() As Variant
i = 1
ReDim t(1 To 100)
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex = 6 Then
t(i) = c.Text
i = i + 1
End If
Next c
Feuil2.[A1].Resize(100) = Application.Transpose(t)
End SubSub aa()
[COLOR=Green]'Déclarations[/COLOR]
Dim c As Range, i As Long, s_tr$, t As Variant
[COLOR=Green]'On parcourt chaque cellule de la zone active[/COLOR]
For Each c In ActiveSheet.UsedRange
[COLOR=Green]'Si la couleur de fond est jaune (cf : 6)[/COLOR]
If c.Interior.ColorIndex = 6 Then
s_tr = s_tr & c.Text & "²"
[COLOR=Green]'alors on concatène la "valeur" de la cellule dans une chaine[/COLOR]
End If
Next c
[COLOR=Green]'on transforme cette chaine en tableau (array)[/COLOR]
t = Split(s_tr, "²")
[COLOR=Green]'On recopie ces valeurs en feuille 2[/COLOR]
Feuil2.[A1].Resize(UBound(t)) = Application.Transpose(t)
End Sub' Macro pour extraire les données contenue dans les cellules ColorIndex jaunes (6)
Sub ExtraireLesDonneesSurFondJaunes()
Dim c As Range, n As Long, i As Long, t() As Variant
n = 1
i = 1
' Dans la feuille active, je cherche les cellules jaunes
' Je veux d'abord chercher le nombre de cellule jaunes
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex = 6 Then
n = n + 1
End If
Next c
' Je dimensionne mon tableau sur le nombre de valeur trouvée
ReDim t(1 To n)
' Et je copie les données dans mon tableau t()
For Each c In ActiveSheet.UsedRange
If c.Interior.ColorIndex = 6 Then
t(i) = c.Text
i = i + 1
End If
Next c
' Je cree maintenant une nouvelle feuille après les autres existante
Worksheets.Add After:=Worksheets(Worksheets.Count)
' Je copie les données dans une colonne
ActiveSheet.[A1].Resize(n) = Application.Transpose(t)
End SubDe quoi parles-tu ?
Sub test()
Dim s_tr$, t
s_tr = "abc²def²ghi²jkl"
t = Split(s_tr, "²")
MsgBox t(0) & vbLf & t(1) & vbLf & t(2) & vbLf & t(3)
End Sub
