verkorten vba code

[mtb]

Hoi,

Ik heb 2 vragen m.b.t. een code


1) Is het mogelijk dat wanneer een tabblad geopend word de macro gaat lopen, zo ja wat is de code hiervoor?

2) Naar aanleiding van de oplossingen die ik heb aangereikt gekregen uit een eerdere vraag (waarvoor hulde) heb ik code (opgenomen met macro recorder) die naar mijn inziens erg lang is, is mij vraag: kan deze code ook korter? Mijn excusses voor de op deze manier geposte code, maar op het werk kan ik op een of andere manier geen code tags, smillies e.d. toepassen

sub Macro1()
'
' Macro1 Macro
' De macro is opgenomen op 22/01/2008 door mtb
'

'
Application.ScreenUpdating = False
ActiveSheet.Unprotect ("pasta")
Columns("P:AB").Select
    Selection.EntireColumn.Hidden = False

 Range("D180").Select
       ActiveCell.FormulaR1C1 = "470"
    Range("Q181:Q196").Select
    Range("Q181:Q196").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("Q178:Q179"), CopyToRange:=Range("D180"), Unique:=True
    Range("D181:K190").Select
    Selection.Sort Key1:=Range("D181"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D191").Select
    ActiveCell.FormulaR1C1 = "520"
    
        Range("R181:R190").Select
    Range("R181:R190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("R178:R179"), CopyToRange:=Range("D191"), Unique:=True
    Range("D192:K197").Select
    Selection.Sort Key1:=Range("D192"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D198").Select
      ActiveCell.FormulaR1C1 = "550"
      
    Range("S181:S190").Select
    Range("S181:S190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("S178:S179"), CopyToRange:=Range("D198"), Unique:=True
    Range("D199:K204").Select
    Selection.Sort Key1:=Range("D199"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D205").Select
       ActiveCell.FormulaR1C1 = "600"
       
       Range("T181:T196").Select
    Range("T181:T196").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("T178:T179"), CopyToRange:=Range("D205"), Unique:=True
    Range("D206:K215").Select
    Selection.Sort Key1:=Range("D206"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D216").Select
       ActiveCell.FormulaR1C1 = "610"
       
       Range("U181:U190").Select
    Range("U181:U190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("U178:U179"), CopyToRange:=Range("D216"), Unique:=True
    Range("D217:K222").Select
    Selection.Sort Key1:=Range("D217"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D223").Select
       ActiveCell.FormulaR1C1 = "620"
       
       Range("V181:V190").Select
    Range("V181:V190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("V178:V179"), CopyToRange:=Range("D223"), Unique:=True
    Range("D224:K229").Select
    Selection.Sort Key1:=Range("D224"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D230").Select
       ActiveCell.FormulaR1C1 = "623"
       
       Range("W181:W190").Select
    Range("W181:W190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("W178:W179"), CopyToRange:=Range("D230"), Unique:=True
    Range("D231:K236").Select
    Selection.Sort Key1:=Range("D231"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D237").Select
       ActiveCell.FormulaR1C1 = "630"
       
      Range("X181:X190").Select
    Range("X181:X190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("X178:X179"), CopyToRange:=Range("D237"), Unique:=True
    Range("D238:K243").Select
    Selection.Sort Key1:=Range("D238"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D244").Select
       ActiveCell.FormulaR1C1 = "640"
       
       Range("Y181:Y190").Select
    Range("Y181:Y190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("Y178:Y179"), CopyToRange:=Range("D244"), Unique:=True
    Range("D245:K250").Select
    Selection.Sort Key1:=Range("D245"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D251").Select
       ActiveCell.FormulaR1C1 = "645"
       
       Range("Z181:Z190").Select
    Range("Z181:Z190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("Z178:Z179"), CopyToRange:=Range("D251"), Unique:=True
    Range("D252:K257").Select
    Selection.Sort Key1:=Range("D252"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D258").Select
       ActiveCell.FormulaR1C1 = "650"
       
       Range("AA181:AA190").Select
    Range("AA181:AA190").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Range("AA178:AA179"), CopyToRange:=Range("D258"), Unique:=True
    Range("D259:K264").Select
    Selection.Sort Key1:=Range("D264"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
       
      Columns("P:AA").Select
    Selection.EntireColumn.Hidden = True
    Range("D180").Select
        ActiveSheet.Protect ("pasta")
      Application.ScreenUpdating = True
      
       End Sub

 

[Wigi]

1.

Gebruik een Activate event.

Klik met rechtermuisknop op de bladtab, kies Programmacode weergeven.

In de dropdowns bovenaan het witte scherm zorg je voor een Worksheet_Activate event (gewoon aanklikken). Vervolgens tussen die 2 lijnen code zet je de eigenlijke code.

2.

Haal de Select eruit.

Bvb.

Columns("P:AB").Select
Selection.EntireColumn.Hidden = False

wordt

Columns("P:AB").EntireColumn.Hidden = False

Wigi

 

[mtb]

Wigi,

bedankt voor je reactie,

voor jouw antwoord op vraag 1: bij mij staat alleen in de witte drop down menu's algemeen en het andere dropdown menu geeft alleen de naam van de macro weer

voor jouw antwoord op vraag 2: ik heb in de hele code de 'select' eruit gesloopt, maar dan loopt die in de 1e regel al vast, zelfs al bij de door jouw gedeclareerde code, ik zal wel weer iets verkeerd doen, maar weet niet wat.

Michel

 

[Wigi]

voor jouw antwoord op vraag 2: ik heb in de hele code de 'select' eruit gesloopt, maar dan loopt die in de 1e regel al vast, zelfs al bij de door jouw gedeclareerde code, ik zal wel weer iets verkeerd doen, maar weet niet wat.

Michel,

als ik in een leeg bestandje dit uitvoer:

Sub e()
    Columns("P:AB").EntireColumn.Hidden = True
End Sub

dan doet het dat gewoon hoor.

Wigi

 

[Hoornvan]

Hallo mtb,

De fout moet ergens in het groene gedeelte zitten geef hij bij mij aan.
Als je de macro met F8 laat lopen en steeds heen en weer schakeld kun je zien wat er gebeurd.

Het in het rood geschreven heb ik er even tussen gezet en dan loopt de macro door tot het volgende stukje code,
zo als het groene en stopt hij weer.

Range("D180").Select
       ActiveCell.FormulaR1C1 = "470"
    [COLOR="Red"]Range("Q181:Q196").Select
    Selection.Copy
    Range("D181").Select
    ActiveSheet.Paste[/COLOR]   
   [COLOR="SeaGreen"] 'Range("Q181:Q196").Select
     'Range("Q181:Q196").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        'Range("Q178:Q179"), CopyToRange:=Range("D180"), Unique:=True[/COLOR]
    Range("D181:K190").Select
    Selection.Sort Key1:=Range("D181"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=2, MatchCase:=False, Orientation:=xlTopToBottom
        Range("D191").Select
    ActiveCell.FormulaR1C1 = "520"

Mvg,
Wim