automatisch uitbreiden formule

[CvD]

Beste lezers,

Ik ben met een script bezig, maar ik zit even opeen dood spoor.
Ik wil een formule toevoegen aan een cel en dat lukt ook met een script.
Dezelfde macro moet er voor zorgen dat elke volgende keer dat ik hem gebruik, de formule uitgebreid wordt.
Onderstaand script werkt.

Sheets(2).Select
    Sheets(2).Copy After:=Sheets(2)
    A = InputBox("Geef hoofdstuk en benaming op")
    strMultiLine = "Rood = 3" & vbCrLf & "Lichtblauw = 8" & vbCrLf & "Donkerblauw = 55" & vbCrLf & "Lichtgeel = 36" & vbCrLf & "Geel = 27" & vbCrLf & "Donkergroen = 50" & vbCrLf & "Oranje = 46" & vbCrLf & "Paars = 26" & vbCrLf & "Lichtgrijs = 15" & vbCrLf & "Donkergrijs = 16"
    MsgBox strMultiLine, 64, "TABKLEUR"
    K = InputBox("Geef nummer tabkleur op")
    Range("D4:I4").Select
    ActiveCell.Value = A
    ActiveSheet.Name = A
    ActiveSheet.Tab.ColorIndex = K
    Sheets("Eindblad").Select
    Range("B23").Select
ActiveCell.FormulaR1C1 = "= " & A & "!R[-1]C"

Alleen elke volgende keer dat ik deze gebruik dan wordt cel B23 overschreven, en ik wil dat de bestaande inhoud behouden blijft. Ik wil van verschillende bladen de waarde uit de cellen bij elkaar optellen.

Ik zie graag een reactie tegemoet.
Alvast bedankt

Mvg
Christ

 

[Superzeeuw]

Om mee te beginnen kan je code korter.
De Msgbox en Input box kun je combineren.
Select is nergens nodig en maakt het alleen maar traag.

Als je de waarde van cel B23 wilt blijven behouden dan zul je iedere keer een andere cel moeten kiezen om de info naar toe weg te schrijven. Jij kiest namelijk zelf als vaste cel B23 zie in jouw code de een na laatste regel.

Sub test()
    Sheets(2).Copy After:=Sheets(2)
    A = InputBox("Geef hoofdstuk en benaming op")
    strMultiLine = "Rood = 3" & vbCrLf & "Lichtblauw = 8" & vbCrLf & "Donkerblauw = 55" & vbCrLf & "Lichtgeel = 36" & vbCrLf & "Geel = 27" & vbCrLf & "Donkergroen = 50" & vbCrLf & "Oranje = 46" & vbCrLf & "Paars = 26" & vbCrLf & "Lichtgrijs = 15" & vbCrLf & "Donkergrijs = 16"
    K = InputBox("Geef nummer tabkleur op:" & vbCrLf & vbCrLf & strMultiLine)
    With ActiveSheet
        .[D4] = A
        .Name = A
        .Tab.ColorIndex = K
    End With
    Sheets("Eindblad").[B23].FormulaR1C1 = "= " & A & "!R[-1]C"
End Sub

 

[CvD]

Superzeeuw,

Bedankt voor je antwoord, maar ik zie even niet hoe dit mijn vraagstelling beantwoord.
Als er iets in een cel staat kan ik met de functietoets F2 iets achter typen.
Dit script zoek ik eigenlijk.


Mvg,
Christ

 

[Superzeeuw]

Alleen elke volgende keer dat ik deze gebruik dan wordt cel B23 overschreven, en ik wil dat de bestaande inhoud behouden blijft. Ik wil van verschillende bladen de waarde uit de cellen bij elkaar optellen.

Als er iets in een cel staat kan ik met de functietoets F2 iets achter typen.

Bedankt voor je reactie maar als ik de beide qoutes lees is mijn vraag wat wil je nu precies?

 

[CvD]

Wat ik wil is een bestaande formule uitbreiden.
Als er een formule in een cel staat, die ik wil uitbreiden dan toets ik F2 in en typ achter de bestaande formule.
Voorbeeld: in cel B3 staat = A1/3600
Ik selecteer nu de cel en toets F2 in.
Dan typ ik bijvoorbeeld *A2 in.
Nu is de formule in cel B3, =A1/3600*A2, geworden.
Deze handelingen wil ik met een script maken.
Moet kunnen lijkt me.

Mvg
Christ

 

[Superzeeuw]

Helder.

Maar waarmee moet de formule dan uitgebreid worden?

 

[CvD]

A & "!R[-1]C"
het gaat om de code om dit te kunnen toevoegen.

Mvg
Christ

 

[Superzeeuw]

Probeer dit stukje code eens.
Vervang de laatste regel uit mijn code voor deze.

Sheets("Eindblad").[B23].FormulaLocal = Sheets("Eindblad").[B23].FormulaLocal & "+ " & A & "!B22"

 

[CvD]

Beste Superzeeuw,

Deze werkt.
Hartstikke bedankt.

Mvg,
Christ