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

Bonjour,

peerl a écrit :

Steelson a écrit :

        .Comment.Text Text:=.Comment.Text & vbCrLf & "valeur de la cellule precedente" & " " & "Nom de la feuille"

Ici, le : "Nom de la feuille" indique qu'il faut préciser le nom de la feuille dans le code? ou ça récupère automatiquement le nom de la feuille source?

... si f1 est la feuille source, mets f1.name, sinon f2.name

peerl a écrit :

Re bonjour,

Dim f1 As Worksheet, f2 As Worksheet, Id As Range, marque As String
Set f1 = Sheets("solde")
Set f2 = Sheets("product")
' de f1 vers f2

de F1 vers F2 : faut il que les feuilles soit dans l'ordre ou le faite qu'on fasse f1 = sheets(" ") suffit pour que le VBA sache dans quelle feuille on est?

puis je utiliser le .ActiveSheet pour indiquer qu'on est dans la bonne feuille solde étant donné que je peux en avoir plusieurs dans le même classeur ?

merci

peu importe l'ordre des feuilles

non, f1=sheets("") ne fonctionne pas, mais tu peux mettre set f1=activesheet

Merci infiniment,

et pour le code commentaire, je l'ai insérer dans le code de transfert comme ça l'insertion du commentaire se fait en même temps que l'exportation des données mais j'ai une erreur de compilation j'imagine que j'ai pas bien fait?

Redonne moi le fichier que je regarde (si besoin en mp)

Steelson a écrit :

Redonne moi le fichier que je regarde (si besoin en mp)

Voilà, j'ai juste ajouter le code commentaire mais je suis pas sur si c'est logique ou pas

Que doit-on mettre à la place de "valeur de la cellule precedente" ?

Steelson a écrit :

Que doit-on mettre à la place de "valeur de la cellule precedente" ?

dans cet exemple j'ai essayé de mettre quelques valeurs dans la feuille product avant exportation. pour tester cela :

Dans cellule ( j , 10) : valeur précédente : 100 & nouvelle valeur source "solde_"

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
                            .Cells(i, j).Copy Destination:=f2.Cells(id.Row, .Cells(1, j))
                            f2.Cells(id.Row, .Cells(1, j)).AddComment "valeur de la cellule precedente" & " " & 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

mais je ne sais pas comment ajouter un commentaire à un commentaire déjà existant ! ouvre un autre topic pour cela !

D'accord je te remercie infiniment pour ton aide

Je te souhaite une bonne soirée

Re bonjour,

Meilleurs voeux,

J'ai une remarque :

avec cette ligne :

f2.Cells(id.Row, .Cells(1, j)).AddComment "valeur précédente" & " " & "source :" & f1.Name

on a pour résultat :

--> Valeur précédente source solde

Comme il n'affiche aucune valeur, j'ai modifier cette ligne comme suite :

                       val =  f2.Cells(id.Row, .Cells(1, j))
                        If Not id Is Nothing Then
                            .Cells(i, j).Copy Destination:=f2.Cells(id.Row, .Cells(1, j))
                            f2.Cells(id.Row, .Cells(1, j)).AddComment "" & val & "- source :" & f1.Name
                        End If

j'ai pour résultat :

--> Valeur précédente ( il affiche la nouvelle valeur et non pas l'ancienne) source solde

pour récupérer l'ancienne valeur, dois je récupérer les valeurs dans tmp avant copie ?

si oui , je sais pas comment le placer dans le code

Merci

Oui en effet, mais je peux récupérer la valeur avant mais pas la source avant car je ne la connait pas !

essaie 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 Destination:=f2.Cells(id.Row, .Cells(1, j))
                            f2.Cells(id.Row, .Cells(1, j)).AddComment "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

Steelson a écrit :

Oui en effet, mais je peux récupérer la valeur avant mais pas la source avant car je ne la connait pas !

J'ai envie de te dire que t'es le meilleur Mercii

Re Bonjour,

Navré !!

Bon.. j'ai trouvé une solution pour l'ajout du commentaire sans l'écraser mais j'ai remarqué qu'il le fait que pour la première valeur exportée et il n'exporte plus les autres cases... est ce qu'il faut ajouter une boucle for ?

Voici la partie commentaire :

 If Not id Is Nothing Then
                            tmp = f2.Cells(id.Row, .Cells(1, j))
                             On Error Resume Next
                             prev_comment = f2.Cells(id.Row, .Cells(1, j)).Comment.Text
                             On Error GoTo 0
                             .Cells(i, j).Copy Destination:=f2.Cells(id.Row, .Cells(1, j))
                             If Len(prev_comment) = 0 Then f2.Cells(id.Row, .Cells(1, j)).AddComment 
                             f2.Cells(id.Row, .Cells(1, j)).AddComment.Text Text:="Valeur précedente" & tmp & vbLf & "- source :" & f1.Name & "  " & Now & Chr(10) & prev_comment
                             End If
End If

Merci pour ta patience

Je pense que d'autres contributeurs auraient pu être sollicités sur ce point.

Steelson a écrit :

mais je ne sais pas comment ajouter un commentaire à un commentaire déjà existant ! ouvre un autre topic pour cela !

Pour ajouter un commentaire à l'existant ...

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

et avec cette fonction, ceci devrait fonctionner ...

                        If Not ID Is Nothing Then
                            tmp = f2.Cells(ID.Row, .Cells(1, j))
                            .Cells(i, j).Copy Destination:=f2.Cells(ID.Row, .Cells(1, j))
                            new_comment f2.Cells(ID.Row, .Cells(1, j)), "valeur de la cellule precedente : " & tmp & " source : " & f1.Name
                        End If

Steelson a écrit :

Je vais quand même regarder mais sur un fichier simple "à part" car à force de tout faire en même temps on ne sait plus où on est ! J'ai en effet des erreurs sur le bout de code que tu proposes ...

Je me suis dis comme c'était ta proposition, ça pouvait être plus simple de vite repérer l’erreur..

sinon, les deux codes a part sont fonctionnel quand je test j'ai bien un commentaire qui est insérer sans écraser l'ancien... mais le soucis c'est qu'il le fait que pour la première case copier/coller, les autres exportation ne se font pas ni valeur ni commentaire. J'ai l'impression, que quand j’insère un code commentaire dans le code transfère il bloque le transfère sans afficher une erreur!

La vie me semble compliquée à l'instant

sinon j'ai ouvert un autre topic sans suite...

En fait il y a un autre soucis

.Cells(i, j).Copy Destination:=f2.Cells(id.Row, .Cells(1, j))

écrase le commentaire précédent ... c'est donc ceci qu'il faut changer !

peerl a écrit :

Steelson a écrit :

Je vais quand même regarder mais sur un fichier simple "à part" car à force de tout faire en même temps on ne sait plus où on est ! J'ai en effet des erreurs sur le bout de code que tu proposes ...

Je me suis dis comme c'était ta proposition, ça pouvait être plus simple de vite repérer l’erreur..

sinon, les deux codes a part sont fonctionnel quand je test j'ai bien un commentaire qui est insérer sans écraser l'ancien... mais le soucis c'est qu'il le fait que pour la première case copier/coller, les autres exportation ne se font pas ni valeur ni commentaire. J'ai l'impression, que quand j’insère un code commentaire dans le code transfère il bloque le transfère sans afficher une erreur!

La vie me semble compliquée à l'instant

sinon j'ai ouvert un autre topic sans suite...

edit : je viens de voir ta fonction je vais la tester

ligne à remplacer par

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