Frankell87
Gebruiker
- Lid geworden
- 7 mei 2015
- Berichten
- 141
Hallo heren,
ik heb onderstaande code die ik nu met een knop oproep maar graag automatisch wil laten lopen als ik de sheet open. nu loop ik alleen tegen het probleem aan dat de macro zelf ook sheetchange bevat en dus gaat vastlopen.
hij moet gaan lopen bij het openen van sheet "Planning".
iemand een idee hoe ik dit kan oplossen?
ik heb onderstaande code die ik nu met een knop oproep maar graag automatisch wil laten lopen als ik de sheet open. nu loop ik alleen tegen het probleem aan dat de macro zelf ook sheetchange bevat en dus gaat vastlopen.
hij moet gaan lopen bij het openen van sheet "Planning".
iemand een idee hoe ik dit kan oplossen?
Code:
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ActiveSheet.AutoFilterMode = False
Application.ScreenUpdating = False
Sheets("New report").Select 'Openen van New Report tab
k = Cells(Rows.Count, "C").End(xlUp).Row - 5 'aantal rijen tellen waarin data staat
Sheets("Planning").Select 'Openen van Planning tab
Range("D6:R6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter 'vanaf cel R6 alles naar links en naar beneden een tabel van maken
Selection.Sort Key1:=Range("E6"), Order1:=xlAscending, Header:=xlYes
Gegevensrij = ("D7:FQ7") '1e rij selecteren
OndersteRij = 7 + k
F = ("D7:FQ" & (OndersteRij)) 'Grootte van het te door te trekken gebied bepalen
Range(Gegevensrij).Select 'rij selecteren die moet worden doorgetrokken
Selection.AutoFill Destination:=Range(F), Type:=xlFillDefault 'doortrekken van de opmaak naar deze cellen
Rows(OndersteRij).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp 'Verwijderen van alle lege rijen
Range("D6:R6").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.AutoFilter 'vanaf cel R6 alles naar links en naar beneden een tabel van maken
Selection.Sort Key1:=Range("K6"), Order1:=xlAscending, Header:=xlYes 'Sorteren op begindatum
Selection.AutoFilter
Application.ScreenUpdating = True
Range("I2").Select
End Sub