Fout in code plakken speciaal

[zwinmi]

Beste forumleden,

Ik heb een exceldocument die op handmatig berekenen staat (anders werkt het programma te traag). Met onderstaande code worden berekeningen uitgevoerd zodra er iets gewijzigd wordt op het geactiveerde sheet.

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

Dit werkt op heel het document prima, behalve op een sheet waar ik onderstaande knop/macro moet uitvoeren. De macro loopt vast op plakken speciaal. Als ik de regel uitschakel werkt de code verders goed. Als het document overigens op automatisch berekenen staat, werkt het plakken speciaal wel goed en heb ik nergens last van, behalve dat het heel traag is.

Wie o wie kan mij hiermee helpen? Bij voorbaat dank!

Sub KostenUrenoverzichtSelectie()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Rows("8:12").Locked = False
    Rows("8:12").FormulaHidden = False
    Rows("8:11").EntireRow.Hidden = False
    With ActiveSheet.Range("A" & Rows.Count).End(xlUp)
        If .Row > 13 Then .EntireRow.Delete
    End With
    ActiveSheet.Range("8:8").Copy
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
   [COLOR="darkred"] ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats[/COLOR]
    Rows("12:12").EntireRow.Hidden = False
    ActiveSheet.Range("12:12").Copy
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
[COLOR="darkred"]    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats[/COLOR]
    Rows("12:12").EntireRow.Hidden = True
    Range("B2").ClearContents
    Range("B3").Select
    Rows("8:12").Locked = True
    Rows("8:12").FormulaHidden = True
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[Roncancio]

Ik heb een aantal opmerkingen:

1. je kunt gebruik maken van UserInterfaceOnly bij protect. Op die manier kan je het werkblad aanpassen met de macro zonder dat je de beveiliging eraf hoeft te halen.
2. Je laat VBA 5 keer in de code naar de laatst ingevulde cel zoeken. Echter deze regel is steeds regel 13 omdat je de regels die eronder zit verwijderd. Dus ipv het zoeken naar de cel kan je m.i. direct rij 13 in de code gebruiken.

De code zal dan ook een stuk korter worden.

Met vriendelijke groet,


Roncancio

 

[HSV]

Zo dan?

Sub KostenUrenoverzichtSelectie()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Rows("8:12").Locked = False
    Rows("8:12").FormulaHidden = False
    Rows("8:11").EntireRow.Hidden = False
    With ActiveSheet.Range("A" & Rows.Count).End(xlUp)
        If .Row > 13 Then .EntireRow.Delete
    End With
    ActiveSheet.Range("8:8").Copy
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial 'xlValues
    'ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Rows("12:12").EntireRow.Hidden = False
    ActiveSheet.Range("12:12").Copy
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial 'xlValues
    'ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Rows("12:12").EntireRow.Hidden = True
    Range("B2").ClearContents
    Range("B3").Select
    Rows("8:12").Locked = True
    Rows("8:12").FormulaHidden = True
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[zwinmi]

Roncancio, bedankt voor je reactie.
Het is niet zo dat alles op rij 13 wordt geplakt. Als rij 13 leeg is, mag de laatste regel (12 dus) niet worden verwijderd, (Rij 1t/m12 zijn standaardwaarden die niet mogen worden verwijderd). Als rij 13 dus gevuld is, mag de laatste wel worden verwijderd. Ik kan zo een selectielijst maken: rij 8 die gekopieerd wordt is een nieuw record in de selectie, rij 12 telt dan de waarden van alle rijen bij elkaar op (rij 13 t/m 1000). Dus de laatste rij is een cummulatieve, die bij een nieuwe selectie mag worden verwijderd, dan wordt de nieuwe record erin geplakt (rij8) en daarna weer cummulatieve (rij12).

Ook HSV, bedankt voor je reactie.
Deze optie werkt niet, omdat er iedere keer maar 1 regel wordt ingevoegd (de nieuwe record, rij8) de cummulatieve wordt niet meegenomen.

 

[HSV]

Hallo zwinmi,

Ik heb niets aan de code veranderd, behalve dat wat jij in twee keer doet, bij mij in één bewerking gaat.

Dus jij plakt eerst de waarden, en daarover de opmaak.

 

[zwinmi]

Hoi Harry,

Je had inderdaad gelijk, er zat een foutje in me code. Dus je code doet het wel, maar het probleem is dat de hele cel dan geplakt wordt als formule, maar er moet juist als waarden geplakt worden. Dus alleen de waarden en de opmaak moeten worden gekopieerd en geplakt. Daarom had ik eerst waarden en daaroverheen de opmaak geplakt.

Ik hoop dat je nog een andere oplossing weet.

Mike

 

[HSV]

Dit schakelt de calculate even uit, maar weet niet precies waar het moet staan (ben geen specialist).
Aldoende leert men zeggen ze.

Sub KostenUrenoverzichtSelectie()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Rows("8:12").Locked = False
    Rows("8:12").FormulaHidden = False
    Rows("8:11").EntireRow.Hidden = False
    With ActiveSheet.Range("A" & Rows.Count).End(xlUp)
        If .Row > 13 Then .EntireRow.Delete
    End With
   [COLOR="red"] Application.EnableEvents = False[/COLOR]
    ActiveSheet.Range("8:8").Copy
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Rows("12:12").EntireRow.Hidden = False
    ActiveSheet.Range("12:12").Copy
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    [COLOR="red"]Application.EnableEvents = True[/COLOR]   
    Rows("12:12").EntireRow.Hidden = True
    Range("B2").ClearContents
    Range("B3").Select
    Rows("8:12").Locked = True
    Rows("8:12").FormulaHidden = True
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[Roncancio]

Roncancio, bedankt voor je reactie.
Het is niet zo dat alles op rij 13 wordt geplakt. Als rij 13 leeg is, mag de laatste regel (12 dus) niet worden verwijderd, (Rij 1t/m12 zijn standaardwaarden die niet mogen worden verwijderd). Als rij 13 dus gevuld is, mag de laatste wel worden verwijderd. Ik kan zo een selectielijst maken: rij 8 die gekopieerd wordt is een nieuw record in de selectie, rij 12 telt dan de waarden van alle rijen bij elkaar op (rij 13 t/m 1000). Dus de laatste rij is een cummulatieve, die bij een nieuwe selectie mag worden verwijderd, dan wordt de nieuwe record erin geplakt (rij8) en daarna weer cummulatieve (rij12).

Ook HSV, bedankt voor je reactie.
Deze optie werkt niet, omdat er iedere keer maar 1 regel wordt ingevoegd (de nieuwe record, rij8) de cummulatieve wordt niet meegenomen.

Oké, duidelijk.
Echter #1 van mijn eerdere bericht blijft staan.
Verder zou ik 1 keer de laatste regel bepalen en de gevonden regelnummer gebruiken in de code en dus niet steeds opnieuw de laatste regel zoeken.

Met vriendelijke groet,


Roncancio

 

[zwinmi]

Hoi Harry, dit was wat ik nodig had. Ik heb hem een beetje moeten aanpassen voor een goede werking en heb ook de regel Activesheet.calculate toegevoegd, zodat de cummulatieve som ook goed berekend wordt. Dit is hem geworden:

Sub KostenUrenoverzichtSelectie()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Rows("8:12").Locked = False
    Rows("8:12").FormulaHidden = False
    Rows("8:11").EntireRow.Hidden = False
    With ActiveSheet.Range("A" & Rows.Count).End(xlUp)
        If .Row > 13 Then .EntireRow.Delete
    End With
    ActiveSheet.Range("8:8").Copy
    [COLOR="darkorange"]Application.EnableEvents = False[/COLOR]
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
   [COLOR="darkorange"] Application.EnableEvents = True
    ActiveSheet.Calculate[/COLOR]    
   Rows("12:12").EntireRow.Hidden = False
    ActiveSheet.Range("12:12").Copy
  [COLOR="darkorange"]  Application.EnableEvents = False[/COLOR]    
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
   [COLOR="darkorange"] Application.EnableEvents = True[/COLOR]   
    Rows("12:12").EntireRow.Hidden = True
    Range("B2").ClearContents
    Range("B3").Select
    Rows("8:12").Locked = True
    Rows("8:12").FormulaHidden = True
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

@Roncancio:
Ik begrijp wat je bedoelt en daardoor zou de code dus een stuk korter worden. Ik ben echter niet zo heel goed met deze codes korter opschrijven dus dat moet ik nog even uitzoeken. Bedankt voor het meedenken allemaal!