Inhoud van tabbladen wissen

[Jack Nouws]

Hallo

Ik heb een macro opgenomen waarbij alle tabbladen geselecteerd worden behalve het eerste tabblad. Dan worden de rijen 5 t/m 79 geselecteerd en wordt de inhoud gewist. Nu ik in de macro kijk vind ik de code een beetje een puinhoop. Zou die code anders geformuleerd kunnen worden?

Met vr gr
Jack.

Sub CmdSeizoenAfsluiten()
'
' CmdSeizoenAfsluiten Macro
'

'
    ActiveWindow.ScrollWorkbookTabs Position:=xlLast
    Sheets(Array("Abies alba", "Abies koreana", "Acer campestre", "Acer negundo", _
        "Acer palm. Atrop.", "Acer palmatum", "Acer palmatum Jap", "Acer palmatum Jap()", _
        "Acer palmatum()", "Acer platanoides", "Berberis thunberghii Atrop", _
        "Betula pendula", "Betula pubescens", "Carpinus betulus", "Cedrus deodara", _
        "Cedrus deodara Spil", "Cedrus deodara()", "Cercidiphyllum japonicum", _
        "Cercis canadensis", "Cercis chinensis", "Cham. lawsoniana", _
        "Cham. lawsoniana Spil", "Cornus alba", "Cornus florida", "Cornus kousa")).Select
    Sheets("Abies alba").Activate
    Sheets(Array("Cornus kousa Chinensis", "Cornus mas", "Cornus sanguinea", _
        "Cryptomeria japonica", "Cryptomeria japonica Spil", "Elaeagnus umbellata", _
        "Fagus sylvatica", "Fraxinus ornus", "Ginkgo biloba", "Gleditsia triacanthos", _
        "Hamamelis virginiana", "Juniperus media Hetzii", "Juniperus virginiana", _
        "Lariks kaempferi", "Liquidambar styraciflua", "Liriodendron tulipifera", _
        "Magnolia kobus", "Metasequoia glyptostroboides", "Picea abies", _
        "Pinus griffithii", "Pinus montana", "Pinus nigra Nigra", "Pinus strobus", _
        "Pinus sylvestris", "Pinus uncinata()")).Select Replace:=False
    Sheets(Array("Pinus uncinata", "Quercus palustris", "Quercus robur", _
        "Quercus rubra", "Robinia pseudoacacia", "Taxodium distichum", "Taxus baccata", _
        "Taxus media Hicksii", "Thuya orientalis", "Viburnum lantana", "Viburnum opulus", _
        "Wisteria sinensis")).Select Replace:=False
    Rows("5:79").ClearContents
    
End Sub

 

[Wigi]

Sub macro1()

    Dim wsSheet As Worksheet

    For Each wsSheet In Worksheets

        If wsSheet.Index > 1 Then
        
            wsSheet.Rows("5:79").ClearContents
        
        End If

    Next

End Sub

Wigi

 

[Jack Nouws]

Ok Wigi Bedankt :thumb:
Het werkt als een trein
met vr gr Jack