code erg traag

[wim1985]

Na veel zwoegen eindelijk een goedwerkende code maar nu is ie erg traag. Ik weet dat je select en dergelijke moet vermijden maar als ik dat probeer ( wat me anders altijd wel aardig lukt) dan krijg ik het niet aan de draai. Zou hier iemand naar kunnen kijken?

Alvast bedankt.

gr Wim

Sub uren_invoeren_hand2()


Application.ScreenUpdating = False
Application.DisplayAlerts = False
    
    With ActiveSheet
        sBestandsnaam = .Range("H11").Value
    End With
    
    With Workbooks
        .Open Filename:="\\DIRKJAN\SharedDocs\Urenregistratiesysteem\nacalculaties\" & sBestandsnaam & ".xls"
    End With
Windows(sBestandsnaam & ".xls").Activate
    Range("Q2:X250").Select
    Selection.Cut
    Range("Q3").Select
    ActiveSheet.Paste
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H12").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("Q2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H13").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("x2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H14").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("v2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H15").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("S2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H16").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("T2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H17").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("R2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Windows(sBestandsnaam & ".xls").Activate
    Range("Q2:X250").Select
    Selection.Sort Key1:=Range("Q2"), Key2:=Range("R2"), Key3:=Range("S2"), Order1:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
ActiveWorkbook.Save
ActiveWorkbook.Close
Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H12:H17").Select
    Selection.ClearContents
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub

 

[Demeter]

ga er van uit dat al je andere bladen al geopent zijn.
werkt een regel zoals:

Windows("urenregistratie.xls").Sheets("invoerenuren").Range("H12").Copy Windows(sBestandsnaam & ".xls").Range("Q2")

ipv

Windows("urenregistratie.xls").Activate
    Sheets("invoerenuren").Select
    Range("H12").Select
    Selection.Copy
    Windows(sBestandsnaam & ".xls").Activate
    Range("Q2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

 

[wim1985]

ik zal dat testen, ik laat het je nog weten.
Alvast bedankt voor de reactie

 

[wim1985]

Heb het getest maar werkt niet. Hij struikelt bij deze regel. Nog andere iedeeen?

gr Wim

 

[Ginger]

Wim1985, De aanroep van je workbook is onjuist. Zo zou de regel wel moeten werken (ongetest!)

Workbooks(sBestandsnaam & ".xls").Range("Q2").value = Workbooks("urenregistratie.xls").Sheets("invoerenuren").Range("H12").value

Beide workbooks MOETEN wel openstaan!

Groet, Leo

 

[GraaffDe]

Het is gewoon een hele lange code dus dat duurd langer voordat die alles is langsgegaan.
Of er zit een fout in de code en dan moet je en breekte punt neerzetten en vervolgen rustig kijken waar de fout zit. als je weet waar het zit zet je dit ervoor: ' zodat hij die regel niet meer leest en dan nog een keer proberen.

MVG GraaffDe

 

[wim1985]

Hoi Leo,

De regel werkt niet. Kun je bedenken wat er fout kan zijn, ik heb al wat dingen getest maar geen resultaat. Beide boeken staan wel open.

Gr Wim

 

[Wigi]

In het linkerdeel van de code ontbreekt een verwijzing naar een werkblad.

 

[wim1985]

Hoi Wim,

Dat is het inderdaad. Ik dacht altijd dat als er maar 1 werkblad dat je deze dan niet hoefde te benoemen maar blijkbaar toch wel.

Weer reuze bedankt, het is erg leerzaam

gr Wim

 

[Ginger]

In het linkerdeel van de code ontbreekt een verwijzing naar een werkblad.

Oeps... (is me bij het vlugge 'inkloppen' niet opgevallen)

Groet, Leo