Renvoyer automatiquement des données d'une feuille à une autre

au global j'arrive à ceci :

Sub transferer()
Dim f1 As Worksheet, f2 As Worksheet, id As Range, marque As String
Set f1 = Sheets("solde")
Set f2 = Sheets("product")
' transfert de f1 vers f2
With f1
    .Select
    For i = 8 To .Range("C" & Rows.Count).End(xlUp).Row
        If .Range("C" & i) <> "" Then
            For j = 6 To .Cells(1, Columns.Count).End(xlToLeft).Column
                ' le fond blanc n'est pas considéré comme couleur ici !
                If .Cells(i, j).Interior.ColorIndex <> xlColorIndexNone And .Cells(i, j).Interior.ColorIndex <> 2 Then
                    marque = .Range("D" & i).Value
                    If marque = "" Then
                        .Range("D" & i).Select
                        MsgBox "Marque absente en D" & i
                    Else
                        Set id = ici(f2.Range("B:B"), .Range("C" & i).Value, marque)
                        If Not id Is Nothing Then
                            tmp = f2.Cells(id.Row, .Cells(1, j))
                            .Cells(i, j).Copy
                            f2.Cells(id.Row, .Cells(1, j)).PasteSpecial Paste:=xlPasteValues
                            Application.CutCopyMode = False
                            new_comment f2.Cells(id.Row, .Cells(1, j)), "valeur de la cellule precedente : " & tmp & " source : " & f1.Name
                        End If
                    End If
                End If
            Next
        End If
    Next

End With
f2.Select

End Sub

Function ici(plage As Range, valeur1 As Variant, valeur2 As Variant) As Range
    With plage
        ok = False
        Set ici = .Find(valeur1, LookIn:=xlValues)
        If Not ici Is Nothing Then
            prem = ici.Address
            Do
                If ici.Offset(0, 5) = valeur2 Then ok = True
                If Not ok Then Set ici = .FindNext(ici)
            Loop While Not ici Is Nothing And ici.Address <> prem And Not ok
        End If
    End With
End Function

Sub new_comment(cel As Range, texte As String)
With cel
    ancien = ""
    On Error Resume Next
        ancien = .Comment.Text
        .ClearComments
    On Error GoTo 0
    .AddComment ancien & texte
End With
End Sub

Steelson a écrit :

ligne à remplacer par

                            .Cells(i, j).Copy
                            f2.Cells(id.Row, .Cells(1, j)).PasteSpecial Paste:=xlPasteValues
                            Application.CutCopyMode = False

Cela fonctionne, mais le PasteSpecial, ne supprime-t-il pas les formules ?

dans ce cas, essaie ceci (cela se rapproche de ta proposition)

                        If Not id Is Nothing Then
                            tmp = f2.Cells(id.Row, .Cells(1, j))
                            On Error Resume Next
                                tmp_comment = f2.Cells(id.Row, .Cells(1, j)).Comment.Text
                                f2.Cells(id.Row, .Cells(1, j)).ClearComments
                            On Error GoTo 0
                            .Cells(i, j).Copy Destination:=f2.Cells(id.Row, .Cells(1, j))
                            f2.Cells(id.Row, .Cells(1, j)).AddComment tmp_comment & vbcrlf & "valeur de la cellule precedente : " & tmp & " source : " & f1.Name
                        End If

Aucun bug, le résultat est là et les deux méthodes fonctionnes et j'ai beaucoup appris merci beaucoup