If not intersect et somme

Bonjour,

Est-il possible avec une macro "If Not Intersect is nothing" d'additionner avec un résultat déjà présent dans un tableau ?

Je vous joins un fichier test avec des commentaires

Merci d'avance pour vos réponses

bonjour,

si j'ai bien compris

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer

    If Not Intersect(Target, Range("D3")) Is Nothing Then

        i = WorksheetFunction.Match(Range("D3"), Range("B12:B24"), 0)

        Range("c8:g8").Copy
        Range("c" & i + 11 & ":G" & i + 11).PasteSpecial Paste:=xlPasteValues
        Range("c" & i + 11 & ":G" & i + 11).PasteSpecial Paste:=xlPasteFormats
        Range("C" & i + 11) = Range("C" & i + 11) + Range("C7") 'on ajoute C7 en colonne C de la ligne en cours

        Application.CutCopyMode = False

        Range("C25") = Application.WorksheetFunction.Sum(Range("C13:C24"))
        Range("D25") = Application.WorksheetFunction.Sum(Range("D13:D24"))
        Range("E25") = Application.WorksheetFunction.Sum(Range("E13:E24"))
        Range("F25") = Application.WorksheetFunction.Sum(Range("F13:F24"))
        Range("G25") = Application.WorksheetFunction.Sum(Range("G13:G24"))

    End If

End Sub

Merci h2so4 pour cette réponse. Mais on ne s'est pas compris.

Si en C14 il y a la somme 100 et qu' en mars on a 30 pour février il faut alors que le total en C14 soit de 130. (C14+C7).

Depuis ce matin, je suis en train de chercher, en oubliant la fonction If not intersect, et additionnant le nombre en colonne D plus une rechecheV .

Cela ne marche pas plus . Je suis vraiment nulle

Sub Fomule()
Dim i As Integer
Dim Dernligne As String

Dernligne = Range("B" & Rows.Count).End(xlUp).Row
On Error Resume Next
For i = 12 To Dernligne

Range("C" & i) = WorksheetFunction.VLookup(Range("B" & i), Range("B7:C9"), 2, False)

If Err.Number <> 0 Then
Range("C" & i) = ""
Err.Clear
End If

Next i

End Sub

rebonjour,

j'ai en effet du mal à comprendre ce que tu veux exactement, je ne suis pas plus sûr d'avoir mieux compris malgré tes nouvelles explications, mais voici :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer

    If Not Intersect(Target, Range("D3")) Is Nothing Then

        i = WorksheetFunction.Match(Range("D3"), Range("B12:B24"), 0)

        Range("c8:g8").Copy
        Range("c" & i + 11 & ":G" & i + 11).PasteSpecial Paste:=xlPasteValues
        Range("c" & i + 11 & ":G" & i + 11).PasteSpecial Paste:=xlPasteFormats
        Range("C" & i + 10) = Range("C" & i + 10) + Range("C7")

        Application.CutCopyMode = False

        Range("C25") = Application.WorksheetFunction.Sum(Range("C13:C24"))
        Range("D25") = Application.WorksheetFunction.Sum(Range("D13:D24"))
        Range("E25") = Application.WorksheetFunction.Sum(Range("E13:E24"))
        Range("F25") = Application.WorksheetFunction.Sum(Range("F13:F24"))
        Range("G25") = Application.WorksheetFunction.Sum(Range("G13:G24"))

    End If

End Sub

Un grand merci. Cela fonctionne très bien.

Bonne fin de journée