Copier coller à un endroit précis

Bonjour le Forum,

Merci pour l'aide que vous voudrez bien m'apporter.

J'ai un fichier avec 12 onglets identiques (12 mois de l'année). J'aimerais que lorsque je mets un "B" dans ma colonne "H" les données de trouvant en colonne B, E, F soit copiées dans les colonnes P,Q,R, à compter de la ligne 12 et si je mets "C" toujours dans la colonne "H", ces mêmes données soient copiées dans les colonnes P,Q,R à compter de la ligne 26 de la même feuille.

Je ne sais pas si je suis très claire, je joins un fichier exemple du résultat souhaité.

J'ai testé pleins de codes, trop de codes.... mais aucun ne donnait ce résultat souhaité.

Merci encore pour votre aide.

bonjojur

dand Excel on préfère des formules, comme ici SOMMEPROD

voir cellules en bleu

bonjour,

une proposition

Sub aargh()
    For Each ws In Worksheets
        dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
        Set rb = ws.Range("P11:s23")
        Set rc = ws.Range("P26:s38")
        rc.ClearContents
        rb.ClearContents
        ic = 0
        ib = 0
        For i = 5 To dl
            If ws.Cells(i, "h") = "B" Then Set r = rb.Columns(1): lig = ib: lib = True Else Set r = rc.Columns(1): lig = ic: lib = False
            Set re = r.Find(ws.Cells(i, "B"), lookat:=xlWhole)
            If re Is Nothing Then
                lig = lig + 1
                If lib Then ib = ib + 1 Else ic = ic + 1
                Set cr = r.Cells(lig, 1)
                cr.Value = ws.Cells(i, "B")
            Else
                Set cr = re
            End If
                If ws.Cells(i, "E") <> "" Then cr.Offset(0, 1) = ws.Cells(i, "E")+cr.offset(0,1)
                If ws.Cells(i, "F") <> "" Then cr.Offset(0, 2) = ws.Cells(i, "F")+cr.offset(0,2)
                cr.Offset(0, 3).FormulaR1C1 = "=rc[-2]-rc[-1]"
                cr.Offset(0, 3).Interior.Color = vbYellow
        Next i
    Next ws
End Sub

Bonjour,

Merci pour ta réponse Jmd. Mais je pense que j'ai oublié de préciser deux choses :

- La 1ère est que je ne veux pas un total mais je veux que toutes les lignes comportant "B" par exemple soient recopiées. C'est pour cette raison que dans mon exemple, j'ai mis Prime en crédit et Vêtement en débit.

- La 2ème est qu'il y aura des lignes où il n'y aura ni B, ni C.

C'est pour ces raisons que je passe par un code VBA et non une formule.

Je viens de voir que j'ai une autre réponse de "h2so4" , je vais l'étudier et la tester, je fais un retour dès que possible.

Merci de prendre du temps pour moi.

planetesud a écrit :

Bonjour,

Merci pour ta réponse Jmd. Mais je pense que j'ai oublié de préciser deux choses :

- La 1ère est que je ne veux pas un total mais je veux que toutes les lignes comportant "B" par exemple soient recopiées. C'est pour cette raison que dans mon exemple, j'ai mis Prime en crédit et Vêtement en débit.

- La 2ème est qu'il y aura des lignes où il n'y aura ni B, ni C.

C'est pour ces raisons que je passe par un code VBA et non une formule.

Je viens de voir que j'ai une autre réponse de "h2so4" , je vais l'étudier et la tester, je fais un retour dès que possible.

Merci de prendre du temps pour moi.

je viens de découvrir les 2 choses que tu as oublié de préciser. Le code fourni n'est pas adapté.

voici le code revu

Sub aargh()
    For Each ws In Worksheets
        dl = ws.Cells(Rows.Count, 1).End(xlUp).Row
        Set rb = ws.Range("P11:s23")
        Set rc = ws.Range("P26:s38")
        rc.ClearContents
        rb.ClearContents
        ic = 0
        ib = 0
        For i = 5 To dl
            If ws.Cells(i, "h") <> "" Then
                If ws.Cells(i, "h") = "B" Then Set r = rb.Columns(1): lig = ib: lib = True Else: Set r = rc.Columns(1): lig = ic: lib = False
                lig = lig + 1
                If lib Then ib = ib + 1 Else ic = ic + 1
                Set cr = r.Cells(lig, 1)
                cr.Value = ws.Cells(i, "B")
                If ws.Cells(i, "E") <> "" Then cr.Offset(0, 1) = ws.Cells(i, "E")
                If ws.Cells(i, "F") <> "" Then cr.Offset(0, 2) = ws.Cells(i, "F")
                cr.Offset(0, 3).FormulaR1C1 = "=rc[-2]-rc[-1]"
                cr.Offset(0, 3).Interior.Color = vbYellow
            End If
        Next i
    Next ws
End Sub

re

salut h2so4

bravo pour le code

ma remarque : c'est une mauvaise idée de dupliquer les informations. C'est contraire aux principes de gestion.

mieux vaut un filtre

Bonsoir et merci beaucoup, je viens de le tester dans mon classeur exemple et cela correspond à ma demande.

Je n'ai malheureusement pas tout compris dans ce code. J'essaie de décortiquer pour mieux comprendre....

Très bonne soirée et merci encore

Rechercher des sujets similaires à "copier coller endroit precis"