[XL-2007] Copie de ligne en fonction de couleur de cellule dans d'autre feuille

[stephadm]

Bonjour au forum,

Je souhaite copier une partie d'une ligne qui est en caractère rouge (mise en forme conditionnelle) sur la feuille "fichier" vers feuille "tableau de bord" (à partir de B24). Plus précisément, il faudrait que ce soit le contenu de la colonne (contrôle entre la ligne2 à 65536) A, K, L, AM et AN de "fichier" vers respectivement B, C, D, E et F

exemple : (ligne caractère rouge uniquement de "fichier")
Feuille "fichier" vers "tableau de bord"
A2/K2/L2/AM2/AN2 vers B24/C24/D24/E24/F24

Avez-vous une idée ?

Merci d'avance

Stéphanie

[Daniel.C]

Bonjour,

Comment obtiens-tu la couleur rouge ? par une formule dans la mise en forme conditionnelle ?
Décris la mise en forme conditionnelle.

[jfontaine]

Bonjour,

Tu peux soit boucler et chercher les lignes avec une police rouge, soit chercher les lignes ayant la même condition que la MFC

Ici on travail sur les lignes avec la police rouge

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
Sub Transfert()
 
Dim i As Long
Dim idest As Long
Dim shSource As Worksheet
Dim shCible As Worksheet
 
Set shSource = Sheets("fichier")
Set shCible = Sheets("tableau de bord")
 
 
idest = 24
 
For i = 2 To shSource.Range("A65536").End(xlUp).Row
 
    If shSource.Range("A" & i).Font.ColorIndex = 3 Then
 
        shCible.Range("B" & idest).Value = shSource.Range("A" & i).Value
        shCible.Range("C" & idest).Value = shSource.Range("K" & i).Value
        shCible.Range("D" & idest).Value = shSource.Range("L" & i).Value
        shCible.Range("E" & idest).Value = shSource.Range("AM" & i).Value
        shCible.Range("F" & idest).Value = shSource.Range("AN" & i).Value
        idest = idest + 1
 
    End If
 
Next i
 
End Sub

[stephadm]

Bonjour Daniel.C et jfontaine,

Daniel.C
Voici ce que j'ai mis en condition dans MFC de la feuille "fichier" : =ET($N2=3;$O2="")

jfontaine
Ou est-ce qu'il faut mettre le code et m'expliquer les différents termes, si je puis dire, employés?
dans Microsoft Excel Objets feuil2(fichier) ou ThisWorkbook car je voudrais que ceci se fasse automatiquement en ouvrant le fichier !

J'ai fait un test en créant un bouton sur la feuille "tableau de bord" en relation avec la macro "transfert" que j'ai mis dans un module3. Quand, j'appuie sur ce bouton, il ne se passe rien du tout alors qu'il y a une ligne rouge dans fichier.

Merci à vous deux

Stéphanie

[jfontaine]

Cette solution utilise ta condition de MFC (c'est plus propre que la couleur)

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
Sub Transfert()
 
Dim i As Long
Dim idest As Long
Dim shSource As Worksheet
Dim shCible As Worksheet
 
Set shSource = Sheets("fichier")
Set shCible = Sheets("tableau de bord")
 
 
idest = 24
 
For i = 2 To shSource.Range("A65536").End(xlUp).Row
 
    If shSource.Range("N" & i).Value = 3 and shSource.Range("O" & i).Value = "" Then
 
        shCible.Range("B" & idest).Value = shSource.Range("A" & i).Value
        shCible.Range("C" & idest).Value = shSource.Range("K" & i).Value
        shCible.Range("D" & idest).Value = shSource.Range("L" & i).Value
        shCible.Range("E" & idest).Value = shSource.Range("AM" & i).Value
        shCible.Range("F" & idest).Value = shSource.Range("AN" & i).Value
        idest = idest + 1
 
    End If
 
Next i
 
End Sub

[Daniel.C]

Essaie :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub test4()
Dim c As Range, Ligne As Long
Ligne = 24
Set sh = Sheets("tableau de bord")
With Sheets("fichier")
    For Each c In .Range(.[A2], .Cells(.Cells.Rows.Count, 1).End(xlUp))
        If .Cells(c.Row, "N") = 2 And .Cells(c.Row, "O") = "" Then
            sh.Cells(Ligne, 2) = .Cells(c.Row, "A")
            sh.Cells(Ligne, 3) = .Cells(c.Row, "K")
            sh.Cells(Ligne, 4) = .Cells(c.Row, "L")
            sh.Cells(Ligne, 5) = .Cells(c.Row, "AM")
            sh.Cells(Ligne, 6) = .Cells(c.Row, "AN")
            Ligne = Ligne + 1
        End If
    Next c
End With
End Sub

[stephadm]

re,

J'ai essayé les solutions que vous me proposez et celle qui fonctionne bien c'est la votre jfontaine.
Par compte, comment automatisé sans cliquer sur bouton ?

Daniel.C, votre solution n'a aucun effet, je ne vois rien apparaitre. Il manque peut-être un petit quelquechose, cependant je vais opter pour la solution de jfontaine sans vous offensez car elle fonctionne et je manque de temps.

En vous remerciant pour votre contributions

Stéphanie

[jfontaine]

Pour que cette macro se lance au demarrage du classeur, tu peux l'appeler dans l'évenement Open du classeur

Code :

1
2
3
Private Sub Workbook_Open()
Transfert
End Sub

[stephadm]

Re,

Merci jfontaine ça fonctionne parfaitement.

Au plaisir

Bonsoir

Stéphanie

[stephadm]

Bonsoir,

je réouvre la discussion car après quelques jours d'utilisation, je m'apercois que les lignes s'affiche toujours alors que dans la feuille "fichier" les conditions ne sont pas remplies. Petit rappel copie certaines infos de colonnes bien précises si une ligne est en rouge (MFC).

Que faut-il prévoir dans

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
Sub Transfert()
 
Dim i As Long
Dim idest As Long
Dim shSource As Worksheet
Dim shCible As Worksheet
 
Set shSource = Sheets("fichier")
Set shCible = Sheets("tableau de bord")
idest = 24
 
For i = 2 To shSource.Range("A65536").End(xlUp).Row
 
    If shSource.Range("N" & i).Value = 3 and shSource.Range("O" & i).Value = "" Then
 
        shCible.Range("B" & idest).Value = shSource.Range("A" & i).Value
        shCible.Range("C" & idest).Value = shSource.Range("K" & i).Value
        shCible.Range("D" & idest).Value = shSource.Range("L" & i).Value
        shCible.Range("E" & idest).Value = shSource.Range("AM" & i).Value
        shCible.Range("F" & idest).Value = shSource.Range("AN" & i).Value
        idest = idest + 1
 
    End If
 Next i
 End Sub

pour que les anciennes infos soit effacées ?

Vous remerciant de votre aide

Stéphanie

[jfontaine]

je m'apercois que les lignes s'affiche toujours alors que dans la feuille "fichier" les conditions ne sont pas remplies

Tu veux parler des lignes de la feuille Cible?

[stephadm]

Bonsoir JFontaine,

Désolé pour le manque de précision, effectivement se sont bien les lignes de la feuille cible que je souhaite effacer automatiquement la condition n' est pas respectée.

Stéphanie

[jfontaine]

Ajoute cette ligne après la déclaration de la variable shcible

Code :

shcible.Range("B24:F" & shcible.Range("B65536").End(xlUp).Row).ClearContents

[stephadm]

re,

J'ai écris 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
Sub Transfert()
 
Dim i As Long
Dim idest As Long
Dim shSource As Worksheet
Dim shCible As Worksheet
shcible.Range("B24:F" & shcible.Range("B34").End(xlUp).Row).ClearContents
 
Set shSource = Sheets("fichier")
Set shCible = Sheets("tableau de bord")
idest = 24
 
For i = 2 To shSource.Range("A65536").End(xlUp).Row
 
    If shSource.Range("N" & i).Value = 3 and shSource.Range("O" & i).Value = "" Then
 
        shCible.Range("B" & idest).Value = shSource.Range("A" & i).Value
        shCible.Range("C" & idest).Value = shSource.Range("K" & i).Value
        shCible.Range("D" & idest).Value = shSource.Range("L" & i).Value
        shCible.Range("E" & idest).Value = shSource.Range("AM" & i).Value
        shCible.Range("F" & idest).Value = shSource.Range("AN" & i).Value
        idest = idest + 1
 
    End If
 Next i
 End Sub

sachant qu'à la ligne B35 il y a un autre tableau dans le même style mais pour d'autres informations.

Ça ne fonctionne pas !

Stéphanie

[jfontaine]

Dans ce cas plutôt cela

Code :

shcible.Range("B24:F34").ClearContents

[gFZT82]

Bonjour stephadm,

Tu n'a pas placé correctement la ligne indiquée par jfontaine.
Elle doit être placée après la ligne qui définit la feuille cible.

Code :

1
2
Set shCible = Sheets("tableau de bord")
shcible.Range("B24:F" & shcible.Range("B34").End(xlUp).Row).ClearContents

Cordialement.

[stephadm]

Bonjour,

C'est bon ça fonctionne,

Merci JFontaine et gFZT82

Maintenant, je veux faire la même chose mais avec date supérieur à aujourd'hui() au lieu des couleurs !

exemple (Affiche dans le tableau les dates en colonne Q supérieur à aujourd'hui)
Ligne 2 la Colonne Q est du 23/09/2011
Ligne 3 la Colonne Q est du 24/09/2011

Feuille "fichier" vers "tableau de bord"
A2/Q2/R2 vers B34/324/324

avez-vous la solution ?

Stéphanie

re,

J'avais une autre demande à propos de ce qui précède

Est-il possible que ces tableaux soit mise à jour immédiatement dès qu'un changement apparait dans fichier ?

Actuellement les macros se lancent au démarrage (appel de celle-ci dans ThisWorkbook) du Fichier excel.

En vous remerciant,

Stéphanie

[stephadm]

Bonjour,

est-ce que une personne aurait une idée pour modifier le code ?

Code :

If shSource.Range("N" & i).Value = 3 and shSource.Range("O" & i).Value => aujourdhui() Then

Merci d'avance pour votre aide

Stéphanie

[AlainTech]

Modifier le code...?
C'est-à-dire?

Est-ce ça que tu veux:

Code :

If shSource.Range("N" & i).Value = 3 and shSource.Range("O" & i).Value => Date Then

???

[stephadm]

Bonjour Alain Tech et le forum,

J'ai essayer votre solution mais sans résultat. Même en réduisant les critères

Code :

if shSource.Range("O" & i).Value => Date Then

Avez-vous une idée ?

Merci d'avance

Stéphanie