Doorkopiëren met macro op ander werkblad

[Warme bakkertje]

Met 1000 artikels in blad Lijst plaats je 9000 formules die bij elke wijziging terug moeten geëvalueerd worden. Ik denk dat het daardoor onvermijdelijk is dat er wachttijden ontstaan. Wil je dit vermijden zal je het toch totaal anders moeten aanpakken om je zoekresultaten neer te zetten in je Blad Lijst maw geen formules maar via VBA en dan nog.

 

[marcelwi]

Rudi,

Was ik al bang voor. 't Is ook geen ramp, 't is gelukkig niet iets wat we 10 keer op een dag moeten doen.
Enige winst die ik voor mijn gevoel nog zou moeten kunnen bereiken is voor de eindegebruiker; die vult vestigingsnummer in en moet dan op Enter drukken zodat zijn gegevens worden opgehaald en vervolgens moet-ie filteren op de niet-lege cellen in kolom E zodat-ie alleen maar de voor hem van belang zijnde regels heeft. Bij dat filteren begint het berekenen wéér terwijl dat net gebeurt is. Is dát wellicht te voorkomen?
Ik kan natuurlijk een knop maken die ze moeten indrukken i.p.v. Enter na het invullen van vestigingsnummer waardoor meteen daarna berekenen wordt uit gezet.
Dat uitzetten van berekenen krijg ik nog wel in een macro, maar hoe zet ik die "Enter" daarin?

Marcel

 

[Warme bakkertje]

Zet deze in Blad Lijst

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$1" Then
        Application.Calculation = xlCalculationManual
        [A2:M2].AutoFilter 5, "<>"
        Application.Calculation = xlCalculationAutomatic
    End If
End Sub

Je hoeft nu enkel het nummer in D1 te wijzigen, bevestigen met Enter en berekenen wordt uitgeschakeld en de lijst wordt gefilterd.

 

[marcelwi]

Rudi,
Klinkt fantastisch, is precies wat ik zou willen maar ik krijg dan telkens een foutmelding op deze regel
[A2:M2].AutoFilter 5, "<>"
heb zelf nog wat andere dingen geprobeerd maar kan geen oplosisng vinden.

gr.
Marcel

 

[Warme bakkertje]

Probeer in deze de nrs 2011 tot 2015 maar eens

 

[marcelwi]

Rudi,

Nou, dat was een latertje....03:40uur?
Maar, het werkt nog niet, krijg ook dezelfde foutmelding. Ik kan ook niet ontdekken wat er veranderd zou zijn. Wellicht per ongeluk originele bestandje weer teruggestuurd?

gr.
Marcel

 

[Warme bakkertje]

Staat de autofilter al aan als je de macro start ? Verwijder anders eens de autofilter en probeer dan deze eens

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$1" Then
        Application.Calculation = xlCalculationManual
        [A2:M2].AutoFilter
        [A2:M2].AutoFilter 5, "<>"
        Application.Calculation = xlCalculationAutomatic
    End If
End Sub

 

[marcelwi]

Rudi,

Dat werkte ook niet. Ik heb wat zitten puzzelen en volgens mij kwam dat doordat de cellen geblokkeerd waren. Ik heb het nu zo opgelost:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$D$1" Then
ActiveSheet.Unprotect
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.AutoFilter Field:=5, Criteria1:="<>"
Range("E1").Select
ActiveCell.FormulaR1C1 = "OK"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFiltering:=True
End If
End Sub

Haal dus gewoon eerst de beveiliging ervan af en converteer na de 1e berekening de formules naar waardes zodat met filteren niet nog eens berekend gaat worden. Heeft één nadeel; als men per omgeluk verkeerd nummer intoetst moet men bestand sluiten en opnieuw beginnen. Maar dat vind ik niet zo erg.
Bij groot bestand ziet eindgebruiker tijdje niks gebeuren, vandaar de "OK" waarschuwing.

Kortom; dit is mijns inziens prima werkbaar, dus bedankt voor je bijdrage!:thumb:

 

[Warme bakkertje]

Deze oogt iets mooier

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$D$1" Then
        With Sheets("Lijst")
            .Unprotect
            .UsedRange.Value = .UsedRange.Value
            .[A2:K2].AutoFilter 5, "<>"
            .[E1].Value = "OK"
            .Protect DrawingObjects:=True, Contents:=True, _
                    Scenarios:=True, AllowFiltering:=True
        End With
    End If
End Sub

 

[marcelwi]

Rudi, oogt inderdaad wat mooier en werkt net zo goed!
Dat bestand werkt nu prima dus daar kan ik wat mensen blij mee maken.

Heb ik nog één vraagje wat een beetje een afgeleide is van dit onderwerp; ik wil het doorkopiëren in een ander bestand gaan gebruiken maar dan loop ik tegen een probleempje aan: in bijgaand bestandje worden op het 2e tabblad formules doorgekopieerd tot aan het aantal regels wat op het 1e tabblad ingevuld is.
Dat werkt hier prima, maar in het oorspronkelijke bestand waar ik dit wil gaan gebruiken staat de regel met formules op het 2e tabblad op regel 7.
Ik heb van alles proberen te wijzigen in die code maar het lukt me niet om 20 regels (=aantal van 1e tabblad) naar beneden door te kopiëren vanaf regel 7 op 2e tabblad.
Het lijkt zoiets simpels, maar ik krijg 't niet voor elkaar.

gr.
Marcel

 

[Warme bakkertje]

Sheets("2").Range("A7:G" & Sheets("1").Cells(Rows.Count, 1).End(xlUp).Row + 5).FillDown

 

[marcelwi]

Fantastisch!. Dat werkt!

Rudi en Superzeeuw reuze bedankt voor de hulp!:thumb::thumb::thumb:

Ik kan dit onderwerp nu afsluiten.

gr.
Marcel