VB code aanpassen

[zwinmi]

Hallo Forumleden,

Ik heb onderstaande VB code achter een knop zittten. Dit werkt goed. Maar ik wil deze iets aanpassen. Nu wordt altijd Rij 8 (rode tekst in code) gekopieerd. Ik wil kunnen switschen tussen Rij 8,9,10 en 11. Dit aan de hand van wat er in een bepaalde cel (L5) staat. Dus staat er in cel L5 "Rij 8" dan moet rij 8 worden gekopieerd, staat er bijv "Rij 10" dan moet dus rij 10 gekopieerd worden. Ik denk dat dit moet met een IF code maar daar kom ik nog niet uit. Ik hoop dat ik zo weer iets kan leren.

Alvast bedankt voor de moeite!

Sub Selectie()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Rows("8:13").Locked = False
    Rows("8:13").FormulaHidden = False
    Rows("8:12").EntireRow.Hidden = False
    With ActiveSheet.Range("A" & Rows.Count).End(xlUp)
        If .Row > 14 Then .EntireRow.Delete
    End With
    [COLOR="red"]ActiveSheet.Range("A8:AS8").Copy
    Application.EnableEvents = False
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats[/COLOR]    
    Application.EnableEvents = True
    ActiveSheet.Calculate
    Rows("13:13").EntireRow.Hidden = False
    ActiveSheet.Range("A13:AS13").Copy
    Application.EnableEvents = False
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Application.EnableEvents = True
    Rows("13:13").EntireRow.Hidden = True
    Range("B2").ClearContents
    Range("B3").Select
    Rows("8:13").Locked = True
    Rows("8:13").FormulaHidden = True
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[Cobbe]

Deze aanpassing doet dat voor u, maar dan moet in L5 enkel een getal komen (5,6,7,8,....) en niet Rij + getal.
Ik weet niet of de rest van de code doet wat ze moet doen..

Sub Selectie()
    Application.ScreenUpdating = False
    ActiveSheet.Unprotect Password:="1"
    Rows("8:13").Locked = False
    Rows("8:13").FormulaHidden = False
    Rows("8:12").EntireRow.Hidden = False
    With ActiveSheet.Range("A" & Rows.Count).End(xlUp)
        If .Row > 14 Then .EntireRow.Delete
    End With
   [COLOR="red"][B] rij = [L5]
    ActiveSheet.Range("A" & rij & ":AS" & rij).Copy[/B][/COLOR]    Application.EnableEvents = False
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Application.EnableEvents = True
    ActiveSheet.Calculate
    Rows("13:13").EntireRow.Hidden = False
    ActiveSheet.Range("A13:AS13").Copy
    Application.EnableEvents = False
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
    ActiveSheet.Range("A" & Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
    Application.EnableEvents = True
    Rows("13:13").EntireRow.Hidden = True
    Range("B2").ClearContents
    Range("B3").Select
    Rows("8:13").Locked = True
    Rows("8:13").FormulaHidden = True
    ActiveSheet.Protect Password:="1"
    Application.ScreenUpdating = True
End Sub

 

[zapatr]

Sub Selectie()
Application.ScreenUpdating = False
With ActiveSheet
.Unprotect Password:="1"
.Rows("8:13").Locked = False
.Rows("8:13").FormulaHidden = False
.Rows("8:12").EntireRow.Hidden = False
With .Range("A" & .Rows.Count).End(xlUp)
If .Row > 14 Then .EntireRow.Delete
End With
If WorksheetFunction.And(.Range("L5").Value >= 8, .Range("L5").Value <= 11) Then
.Range("A" & .Range("L5").Value & ":AS" & .Range("L5").Value).Copy
Application.EnableEvents = False
.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
.Range("A" & .Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
Application.EnableEvents = True
End If
.Calculate
.Rows("13:13").EntireRow.Hidden = False
.Range("A13:AS13").Copy
Application.EnableEvents = False
.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
.Range("A" & .Rows.Count).End(xlUp).Offset(0).PasteSpecial xlFormats
Application.EnableEvents = True
.Rows("13:13").EntireRow.Hidden = True
.Range("B2").ClearContents
.Range("B3").Select
.Rows("8:13").Locked = True
.Rows("8:13").FormulaHidden = True
.Protect Password:="1"
End With
Application.ScreenUpdating = True
End Sub

 

[zwinmi]

@Cobbe,

Hartelijk dank voor je oplossing, is was precies wat ik nodig had en werkt perfect!

 

[zwinmi]

Ook zapatr bedankt voor je reacti!
Ik zet er een slotje op.