Copie de ligne en fonction de couleur de cellule dans d'autre feuille

**stephadm** · 19/09/2011, 18h28

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** · 19/09/2011, 19h29

Bonjour,

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

**jfontaine** · 19/09/2011, 19h38

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 19/09/2011, 20h31

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** · 19/09/2011, 21h01

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 19/09/2011, 21h13

Essaie :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 19/09/2011, 21h35

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** · 19/09/2011, 21h45

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Private Sub Workbook_Open()
Transfert
End Sub

**stephadm** · 19/09/2011, 22h03

Re,

Merci jfontaine ça fonctionne parfaitement.

Au plaisir

Bonsoir

Stéphanie

**stephadm** · 22/09/2011, 21h33

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 22/09/2011, 21h38

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** · 22/09/2011, 21h44

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** · 22/09/2011, 21h48

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**stephadm** · 22/09/2011, 22h05

re,

J'ai écris ceci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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** · 22/09/2011, 22h23

Dans ce cas plutôt cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

**gFZT82** · 22/09/2011, 23h17

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 :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Cordialement.

**stephadm** · 23/09/2011, 07h46

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** · 25/09/2011, 13h24

Bonjour,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Merci d'avance pour votre aide

Stéphanie

**AlainTech** · 25/09/2011, 13h59

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

Est-ce ça que tu veux:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

???

**stephadm** · 26/09/2011, 07h40

Bonjour Alain Tech et le forum,

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

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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

Avez-vous une idée ?

Merci d'avance

Stéphanie

Copie de ligne en fonction de couleur de cellule dans d'autre feuille

Macros et VBA Excel

Discussions similaires

Partager

Partager