Ultimate fonction VB

[nicof]

Bonjour a tous,

je suis egalement debutant en VBA, voici ce que j'aimerais faire

dans la feuille 1 de mon classeur il y a six colonnes de quinze lignes.

je voudrais que VBA me trouve automatiquement toutes les cellules de la colonne 6 dont la valeur commence par le texte "Code", puis qu'il colore en rouge la ligne entière dans laquelle se trouve la cellule.

Ensuite j'aimerais qu'il me copie ces lignes et les colle sur la feuille 2 du meme classeur

J'ai le debut du code :

Sub Colorelignessiproblemesindicateurs()
Range("F1:F15").Select
For Each Cell In Selection
If Left$(Cell.Value, 4) = "Code" Then
Cell.EntireRow.Interior.Color = vbRed
Else
Cell.EntireRow.Interior.Color = vbWhite
End If
Next Cell
End Sub

Mais j'ai un pb ensuite

Je pense que si je veux inserer la deuxieme partie de ma requete à savoir copier coller) dans une seule procedure mon code est mauvais

merci de votre aide

 

[pierrejean]

Re : Ultimate fonction VB

bonjour nicof

A tester:

.....
If Left$(Cell.Value, 4) = "Code" Then
Cell.EntireRow.Interior.Color = vbRed
[COLOR=blue]Cell.EntireRow.Copy destination:=Sheets("Feuil2").Range("A65536").end(xlup).offset(1,0)
[/COLOR]Else
.....

 

[nicof]

Re : Ultimate fonction VB

bonjour nicof

A tester:

.....
If Left$(Cell.Value, 4) = "Code" Then
Cell.EntireRow.Interior.Color = vbRed
[COLOR=blue]Cell.EntireRow.Copy destination:=Sheets("Feuil2").Range("A65536").end(xlup).offset(1,0)
[/COLOR]Else
.....

Merci bien ca marche

Toutefois je je souhaite plutot copier coller ces lignes sur la feuille 2, revenir sur la feuille 1 et les colorer en rouge comment faire?

ce que j'ai tente ne marche bien sur pas

Sub Colorelignessiproblemesindicateurs()
Range("F1:F15").Select
For Each Cell In Selection
If Left$(Cell.Value, 4) = "Code" Then
Cell.EntireRow.Copy Destination:=Sheets("Tabelle2").Range("A65536").End(xlUp).Offset(1, 0)
Sheets("Tabelle1").Cell.EntireRow.Interior.Color = vbRed
Else
Cell.EntireRow.Interior.Color = vbWhite
End If
Next Cell
End Sub

 

[nicof]

Re : Ultimate fonction VB

pas de nouvelle mauvaise nouvelle

 

[pierrejean]

Re : Ultimate fonction VB

Re

il suffit d'inverser le 2 lignes

.....
If Left$(Cell.Value, 4) = "Code" Then
[COLOR=blue]Cell.EntireRow.Copy destination:=Sheets("Feuil2").Range("A65536").end(xlup).offset(1,0)[/COLOR]
[COLOR=blue][COLOR=#000000]Cell.EntireRow.Interior.Color = vbRed[/COLOR]
[/COLOR]Else
.....