Alleen active sheet herberekenen

[zwinmi]

Beste Forumleden,

Ik heb een werkmap die op handmatig berekenen staat, omdat het vrij complex is en dus traag werkt als die op automaitsch staat. Nu wil ik dat alleen het actieve sheet wordt herberekend als ik iets veranderd, maar de andere sheets dus niet. Ik had de volgende code al gekregen, maar dat werkt alleen 1x op het moment dat het sheet geopend wordt, als ik daarna iets verander wordt de sheet niet herberekend. Er moet dus continue herberekend worden of als ik iets verander...

Private Sub Worksheet_Activate()
ActiveSheet.Calculate
End Sub

Alvast bedankt!

 

[richard1970]

Beste zwinmi,

Ik werk met Excel 2003.
De code:

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Calculate
End Sub

Dien je als event achter ieder werkblad te hangen.
Ik ben geen VBA-deskundige, maar bij mij werkt dit.

Richard

 

[zwinmi]

Hoi Richard,

bedankt voor je antwoord! Het werkt.....maar nu door deze code is er nu een ander probleem Ik heb op alle bladen knoppen met ongeveer dezelfde code als onderstaande en ze lopen allemaal mis op dezelfde regel, die heb ik rood gekleurd. Heb je misschien enig idee hoe ik dit kan ondervangen?

Alvast hartelijk bedankt

Sub PrestatiesOpslaan()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Sheets("DataPrestatie").Unprotect Password:="1"
    Sheets("DataPrestatie").Range("2:2").Copy

    Sheets("DataPrestatie").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
 [COLOR="darkred"]   Sheets("DataPrestatie").Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats[/COLOR]
    Range("C4:C6").Select
    Selection.ClearContents
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    ActiveWorkbook.Save
    Sheets("DataPrestatie").Protect Password:="1"
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[HSV]

Lukt het zo Zwinmi ?

Sub PrestatiesOpslaan()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Sheets("DataPrestatie").Unprotect Password:="1"
    Sheets("DataPrestatie").Range("2:2").Copy
    Sheets("DataPrestatie").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial
    Range("C4:C6").ClearContents
    Range("C3").Select
    ActiveCell = Date
    ActiveWorkbook.Save
    Sheets("DataPrestatie").Protect Password:="1"
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[Warme bakkertje]

Misschien op deze manier

Sub PrestatiesOpslaan()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    With Sheets("DataPrestatie")
        .Unprotect Password:="1"
        .Range("2:2").Copy
        With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .PasteSpecial xlPasteValues
            .PasteSpecial xlPasteFormats
        End With
        .Protect Password:="1"
    End With
    [C4:C6].ClearContents
    [C3] = "=TODAY()"
    ActiveSheet.Protect Password:="1"
    ActiveWorkbook.Save
    Application.ScreenUpdating = True
End Sub

 

[Roncancio]

Ik zou gebruik maken van ThisWorkbook.

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveSheet.Calculate
End Sub

Zodra je een andere cel selecteert in een bepaald werkblad, dan wordt dat betreffende werkblad opnieuw berekend.
Je hoeft dus niet voor elk werkblad apart code in te voeren.

Met vriendelijke groet,


Roncancio

 

[zwinmi]

Heren, hartelijk bedankt voor jullie reacties!:thumb: Ik heb ze allemaal uitgeprobeerd, hieronder mijn bevindingen:

@ HSV: Ja deze code doet het wel!
@ Warm Bakkertje: Deze code doet het niet, hij loopt weer vast op de PasteFormats
@ Roncancio: Dit zou inderdaad wel makkelijk zijn, maar er wordt pas herberekend als je van cel wisselt, ik heb ook een dropdownlist waarna celinhoud wordt veranderd, dus wil dat het gelijk berekend wordt zonder van cel te wisselen. Met de code die achter ieder blad staat hoef ik niet van cel te wisselen en wordt er gelijk herberekend. Maar misschien kan je dat ook aanpassen in jouw code?

 

[Roncancio]

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
ActiveSheet.Calculate

End Sub

Met vriendelijke groet,


Roncancio

 

[zwinmi]

Roncancio bedankt voor je code, super!
Ik zal een slotje op dit draadje zetten. Alle anderen ook bedankt voor het meedenken!