2 programmacodes combineren in 1 werkblad

[mooske04]

Vraagje: in de programmacode van mijn werkblad wil ik 2 opdrachten uitvoeren. De eerste code is van automatisch sorteren in het blad, de 2e is voor het automatisch aanmaken van een nieuw werkblad. Ik krijg echter steeds een foutmelding, die ik er niet uit krijg.....

Gebruikte codes, die elk afzonderlijk wel werken, maar samen niet:
1)

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("f8:f10")) Is Nothing Then Exit Sub
   Sheets("Blad 1").Range("a18:k30").Sort _
Key1:=Range("B18"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("a1").Select
End Sub

2)

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("d6:d12")) Is Nothing Then
    Sheets("blad 2").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Target
End If
End Sub

Wie helpt me deze 2 te koppelen/combineren?!

 

[mooske04]

Pfff, de smilie moet natuurlijk zijn: Range("d6:d12")

 

[mooske04]

Hmm, wil ook niet... Iig gewoon een : en dan een d

 

[huijb]

Je dient ook de code tussen codetags te plaatsen. Zie ook hier voordat je een vraag plaatst. http://www.helpmij.nl/forum/showthread.php/321171-Lees-dit-eerst-voor-je-een-vraag-plaatst.

 

[edmoor]

Volgens mij moet het dan dit zijn:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("F8:F10")) Is Nothing Then Exit Sub

    Sheets("Blad 1").Range("A18:K30").Sort _
	Key1:=Range("B18"), Order1:=xlAscending, _
	Header:=xlGuess, OrderCustom:=1, _
	MatchCase:=False, Orientation:=xlTopToBottom
	Range("A1").Select

    If Not Intersect(Target, Range("D6:D12")) Is Nothing Then
	Sheets("blad 2").Copy after:=Sheets(Sheets.Count)
	Sheets(Sheets.Count).Name = Target
    End IF
End Sub

Als dat het niet is dan moet je even een voorbeelddcument plaatsen.

 

[mooske04]

Ha Edmoor,

Bedankt, maar het is het nog niet helemaal. Het sorteren gaat goed, maar er wordt een nieuw blad aangemaakt als ik kolom F wijzig.
Sorteren moet nav wijziging in kolom F,
het aanmaken obv wijziging in kolom D. De codes moeten dus ook apart werken, als er bijv alleen in kolom F OF D gewijzigd wordt.

Zou graag het bestand plaatsen voor de duidelijkheid, maar na het aanklikken van uploaden, verschijnt ie niet in mn bestandenlijstm dus helaas....

 

[OctaFish]

Heb je 'm al gezipt? Dat wil meestal wel helpen.

 

[edmoor]

Ha Edmoor,

Bedankt, maar het is het nog niet helemaal. Het sorteren gaat goed, maar er wordt een nieuw blad aangemaakt als ik kolom F wijzig.
Sorteren moet nav wijziging in kolom F,
het aanmaken obv wijziging in kolom D. De codes moeten dus ook apart werken, als er bijv alleen in kolom F OF D gewijzigd wordt.

Je wilde het gecombineerd hebben in 1 routine en dat is dan wat er gebeurd.
Als je het anders wilt zul je de condities waaronder iets plaats moet vinden moeten wijzigen in die routine.

 

[mooske04]

Edmoor, dan heb ik het misschien verkeerd uitgelegd.
De codes moeten afzonderlijk van elkaar werken, maar in 1 werkblad in de programmacode staan.

Maar als ik ze allebei plaats:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("f8:f10")) Is Nothing Then Exit Sub
   Sheets("Blad 1").Range("a18:k30").Sort _
Key1:=Range("B18"), Order1:=xlAscending, _
Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
Range("a1").Select
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("d6:d12")) Is Nothing Then
    Sheets("blad 2").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Target
End If
End Sub

Dan krijg ik de melding dat er een compileerfout gevonden is, nl. dubbelzinnnige naam gevonden: Worksheet _ Change. Hoe krijg ik die eruit? Bestand heb ik bijgevoegd, btw.

 

[edmoor]

Je hebt dan 2 functies met dezelfde naam, dan kan sowieso niet.

 

[mooske04]

Dat snap ik wel, maar hoe waarin hernoem ik 1 vd 2 dan?

 

[edmoor]

Hernoemen zal niet gaan als ze beiden op het event Worksheet_Change moeten reageren.
Dan moet je ze samenvoegen zoals in mijn voorbeeld en dan in de routine zelf de conditie bepalen waarin wat moet worden uitgevoerd.

 

[mooske04]

ik kan dus niet in 1 routine kolom f wijzigen en sorteren EN een andere wijziging in kolom D doorvoeren en dan een nieuw blad aanmaken? Nu sorteert ie En maakt ie een nieuw blad aan nav een wijzigiing in alleen kolom F

 

[edmoor]

Tuurlijk kan dat. Dan moet je die verschillende condities afvangen in de code.

 

[mooske04]

Ja, daar ga ik dus weer de mist in.....
Met deze code:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("f29:f2000")) Is Nothing Then Exit Sub
    ActiveSheet.Range("A29:m2000").Sort _
    Key1:=Range("B29"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom
    Range("A1").Select
 
If Not Intersect(Target, Range("d8:d26")) Is Nothing Then
    Sheets("basis").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Target
End If
End Sub

Maakt ie dus geen nieuw blad aan, het sorteren gaat wel goed. De juiste range heb ik ingevoerd, waarom kopieerd ie dan niet?

 

[edmoor]

Waarschijnlijk omdat deze niet waar is:

If Not Intersect(Target, Range("d8:d26")) Is Nothing

 

[mooske04]

Maar als ik er een If van maak, loopt ie ook niet. Ik heb al van alles geprobeerd en gewijzigd gehad, maar ik krijg niet de juiste code voor elkaar. Waarbij dus wanneer Of in kolom D EN/OF in kolom F iets wordt gewijzigd, dan dus gesorteerd en/of toegevoegd wordt...... Suggesties?

 

[edmoor]

Schrijf het eens fonetisch voor jezelf uit, dus:
IF er in kolom D iets gewijzigd wordt OR er iets in KOLOM F iets gewijzigd wordt THEN
'Code
ELSE
'Code
ENDIF

 

[mooske04]

Dan krijg je dus dit?

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="red"]If Intersect(Target, Range("d8:d26")) Or Intersect(Target, Range("f29:f2000")) Then[/COLOR]
    Sheets("basis").Copy after:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = Target
Else
    If Intersect(Target, Range("f29:f2000")) Is Nothing Then Exit Sub
    ActiveSheet.Range("A29:m2000").Sort _
    Key1:=Range("B29"), Order1:=xlAscending, _
    Header:=xlGuess, OrderCustom:=1, _
    MatchCase:=False, Orientation:=xlTopToBottom
    Range("A1").Select
 End If
End Sub

Bovenstaand (zal jou niet verbazen, maar ik zie de fout niet) werkt niet. Ik krijg die If/Or niet rond.....

 

[edmoor]

Je mist een End If.

Maar zo heb je nog steeds exact hetzelfde als eerder.
WANNEER moet er een copy worden gemaakt en WANNEER moet er gesorteerd worden.