si cellule identique alors copie avec conditions

[grotsblues]

Bonsoir

Débutante en VBA et après mainte recherche sur forum, j'ai trouvé un code vba qui me copie une ligne entiere or je souhaiterai qu'il ne copie que les cellules avec une condition
Ci-joint exemple avec j'espère une explication claire

merci d'avance pour vos réponses

 

[Modeste]

Re : si cellule identique alors copie avec conditions

Bonjour grotsblues,

En colonne A de la feuille Rapport, il y a des valeurs en double (A9/A10, A11/A15 et A14/A18) ... Est-ce normal?
En l'état actuel, la macro ne saurait trouver que la première occurrence!?
Et ta macro tu ne l'exécuteras qu'une seule et unique fois sur ce fichier?

 

[grotsblues]

Re : si cellule identique alors copie avec conditions

Bonjour

Non cela n'est pas normal, il ne faut pas tenir compte de la ligne 9, et la macro sera excécutée à chaque mise à jour de la feuille BALANCE A INTEGRER.

Merci pour votre réponse, en attendant votre aide
J'ai trouver sur le forum le code si dessous, il fonctionne mais il me manque :

Dans feuille (rapport) la copie sur la derniere ligne vide les cellules manquantes et de copier le montant (rapport) dans la bonne colonne en fonction de la cellule H7 (rapport) et la cellule G5 (balance a integrer)

Sub Recopiebis()
Dim Cel As Range
Dim J As Long

With Sheets("rapport")
For J = 9 To Range("A" & Rows.Count).End(xlUp).Row
Set Cel = .Columns("A").Find(what:=Range("A" & J), LookIn:=xlValues, lookat:=xlWhole)
If Not Cel Is Nothing Then
Range("G" & J).Copy Cel.Offset(0, 7) ' copier g en h
End If
Next J
End With
End Sub

 

[grotsblues]

Re : si cellule identique alors copie avec conditions

Bonsoir

SVP Personne pour m'aider ?

 

[Modeste]

Re : si cellule identique alors copie avec conditions

Bonjour,

Si tu attends de l'aide, il faut que tu prennes, de ton côté- un peu de temps aussi:

• tu dis que l'existence de doublons en colonne A de la feuille Rapport n'est pas normale ... et si tu déposais, dans ce cas, un exemple "normal"!?
• tu dis qu'il ne faut pas tenir compte de la ligne 9 ... tu parles des doublons? mais quid des autres, alors?
• le code en A15 qui semble être un doublon de A11, n'est pas le résultat de la concaténation de B15 et C15 (contrairement à ce que laissent croire les formules en lignes 9 & 10, ainsi qu'à partir de A19 et les valeurs des lignes 11 à 18)? C'est un véritable doublon (à supprimer) ou une erreur d'un autre type?

Si ta macro est exécutée à chaque mise à jour de la feuille BALANCE A INTEGRER, dans le cas où une valeur identique est trouvée en colonne A des 2 feuilles et qu'un montant figure déjà en colonne H de la feuille Rapport, on "écrase" le montant en question, sans se poser de questions?

Si tu supprimes les lignes 10, 15 et 18 de ton premier fichier et que la réponse à ma dernière question est "oui", il me semble que la modification suivante de ton code de départ, donne le résultat attendu:

Sub copiePV()
Dim Cel As Range, C As Range
Dim LigneAjout As Long
    Application.ScreenUpdating = False
    For Each Cel In Sheets("BALANCE A INTEGRER").Range("A9:A" & Sheets("BALANCE A INTEGRER").Range("A" & Rows.Count).End(xlUp).Row)
        Set C = Sheets("RAPPORT").Columns(1).Find(Cel, , xlValues, xlWhole)
        If Not C Is Nothing Then
            Cel.Offset(0, 6).Copy
            Sheets("RAPPORT").Range("H" & C.Row).PasteSpecial (xlPasteValues)
        Else
            LigneAjout = Sheets("RAPPORT").Range("A" & Rows.Count).End(xlUp).Row + 1
            Cel.Resize(, 5).Copy
            Sheets("RAPPORT").Range("A" & LigneAjout).PasteSpecial (xlPasteValues)
            Cel.Offset(0, 6).Copy
            Sheets("RAPPORT").Range("H" & LigneAjout).PasteSpecial (xlPasteValues)
        End If
    Next Cel
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Set C = Nothing
End Sub

... Je t'encourage cependant à réfléchir aux implications, aux différents cas de figure qui pourraient se présenter et aux risques encourus, en cas d'erreur!

 

[grotsblues]

Re : si cellule identique alors copie avec conditions

Bonjour Modeste et merci de ton aide

La macro fonctionne trés bien, mais elle sera exécutée à chaque fois que la feuille (balance a integrer) sera modifier (les montant, la date...), c'est pour cela qu'il me faudrait une condition supplémentaire, c'est à dire que si la cellule G5 (balance a integrer) est FEVRIER alors copie les montants dans la colonne H de (rapport), si la cellule G5 (balance a integrer) est JANVIER alors copie les montants dans la colonne G de (rapport) etc...afin d'éviter qu'on ecrase les montants en questions comme tu me le fait remarqué dans ta réponse. Je pense qu'il faudrait rajouter en IF... THEN mais je ne vois pas comment l'écrire.

Et encore Merci de ton aide,

 

[Modeste]

Re : si cellule identique alors copie avec conditions

c'est pour cela qu'il me faudrait une condition supplémentaire

Et nous, c'est pour ça qu'on pleure après des fichiers qui soient représentatifs de la situation réelle

J'imagine que tu as réfléchi, comme je te le suggérais ... On dirait un dialogue avec mon chef puisqu'une idée lui est venue, elle est forcément excellente et ne souffre pas même d'être questionnée ... suppose -rien qu'un instant- que tu oublies de modifier le mois en G5 (oui, je sais, tu vas me dire que ça n'arrivera jamais!), tu exécutes la macro et, comme le temps presse, tu enregistres. Tu vois ce que je veux dire?

Ceci dit, ça reste du domaine de ta responsabilité (moi, ce que j'en dis ... ) essaie cette adaptation de ma proposition:

Sub copiePV()
Dim Cel As Range, C As Range
Dim LigneAjout As Long
    colCible = Application.Match(Sheets("BALANCE A INTEGRER").[G5], Sheets("Rapport").[7:7], 0) 'trouver la colonne du mois en G5
    If IsError(colCible) Then Exit Sub 'si mois en G5 pas renseigné ou mal orthographié
    Application.ScreenUpdating = False
    For Each Cel In Sheets("BALANCE A INTEGRER").Range("A9:A" & Sheets("BALANCE A INTEGRER").Range("A" & Rows.Count).End(xlUp).Row)
        Set C = Sheets("RAPPORT").Columns(1).Find(Cel, , xlValues, xlWhole)
        If Not C Is Nothing Then
            Cel.Offset(0, 6).Copy
            Sheets("RAPPORT").Cells(C.Row, colCible).PasteSpecial (xlPasteValues)
        Else
            LigneAjout = Sheets("RAPPORT").Range("A" & Rows.Count).End(xlUp).Row + 1
            Cel.Resize(, 5).Copy
            Sheets("RAPPORT").Range("A" & LigneAjout).PasteSpecial (xlPasteValues)
            Cel.Offset(0, 6).Copy
            Sheets("RAPPORT").Cells(LigneAjout, colCible).PasteSpecial (xlPasteValues)
        End If
    Next Cel
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Set C = Nothing
End Sub

... Tu nous diras quand même si c'est OK?

 

[grotsblues]

Re : si cellule identique alors copie avec conditions

Merci, merci tout fonctionne comme je le souhaitais, j'espere qu'il conviendra aussi à mon chef hi hi hi hi.....