Exporter des données si elles sont en gras

Bonjour,

J'ai cherché sur plusieurs forums, mais aucun ne me proposait la réponse que j'attendais. En fait je voudrais exporter les données d'une feuille vers une autre uniquement si elles sont en gras.

Par exemple, dans mon fichier, je voudrais que sur la feuille 2 apparaissent en A les dates de la feuille 1 uniquement si la cellule correspondante en B ou en C est en gras, et en B la valeur des cellules (toujours numéraire, même si cela ne doit pas changer grand chose) si elles sont en gras, le tout de façon automatisée le plus possible.

Pouvez-vous m'aider ? Je dois avouer que je désespère un peu...

Merci de votre attention et bonne journée !

Hello,

Peut être avec une condition?

If Cells(x, x).Font.Bold = True Then
Ton code de copie

Pour être plus précis tu peux tenter ce code:

Sub macro_test()
ligne_feuille2 = 1

For i = 3 To Sheets("Feuil1").Range("A2").End(xlDown).Row
If Cells(i, 2).Font.Bold = True Or Cells(i, 3).Font.Bold = True Then
Sheets("Feuil2").Cells(ligne_feuille2, 1).Value = Sheets("Feuil1").Cells(i, 1).Value
If Cells(i, 2).Font.Bold = True Then Sheets("Feuil2").Cells(ligne_feuille2, 2).Value = Sheets("Feuil1").Cells(i, 2).Value
If Cells(i, 3).Font.Bold = True Then Sheets("Feuil2").Cells(ligne_feuille2, 2).Value = Sheets("Feuil1").Cells(i, 3).Value
ligne_feuille2 = ligne_feuille2 + 1
End If
Next i

End Sub

Bonjour Razorbill,

A tester cordialement.

Super, je dois pouvoir arriver à me débrouiller avec ça, merci beaucoup !!

Re-bonjour,

J'ai réussi à adapter la formule, maintenant je voudrais une macro qui puisse effacer toutes les cellules qui ne sont pas en gras sur ce nouveau tableau. J'ai essayé d'adapter la formule comme ceci :

Sub Bouton1_Cliquer()

Application.ScreenUpdating = False
Sheets(2).Activate
Cells.Select
    Selection.Delete Shift:=xlUp
derligne = Cells(Rows.Count, 1).End(xlUp).Row

For j = 6 To derligne
    If Range("D" & j).Font.Bold = False Then
    Range("D" & j).Select
    Selection.Clear
    End If
    'If Range("E" & j).Font.Bold = False Then
    'Range("E" & j).Clear
    'End If
    'If Range("F" & j).Font.Bold = False Then
    'Range("E" & j).Clear
    'End If

Next j
Application.CutCopyMode = False
Sheets(2).Activate
Range("A1").Select
Application.ScreenUpdating = True

Sauf que ça efface tout

Quelqu'un aurait une solution pliz ? :'(

Euh oui ça efface tout puisque c'est ce que tu lui demande en premier:

Cells.Select
    Selection.Delete Shift:=xlUp

Quelles sont les cellules qui ne sont pas en gras puisque la macro copie uniquement les valeurs en gras??

Je me suis juste embrouillé tout seul, merci

Bon, normalement, cela devrait être ma dernière requête pour ce problème...

Est-ce que quelqu'un peut me dire pourquoi ça marche pas ? La macro efface bien comme je lui ai demandé, mais le test ne renvoie rien :'(