Kopieeractie op basis slectie van autofilter

[boome]

Ik heb een dynamisch bereik gemaakt genaamd PRL_DATA_COPY de achterliggende formule is de volgende:
=VERSCHUIVING(PRL!$A$1;2;0;AANTALARG(PRL!$A:$A)-1;24).

Dit dynamisch bereik wordt gebruikt in een macro om een bepaalde selectie te kopi�ren, die wordt opgezet dmw een autofilter.
Alles werkt perfect zolang de autofilterselectie een reeks gegevens als resultaat heeft.
De autofilter werkt met 2 filters: Type G en gekopieerd N.
Het kan echter voorvallen dat de autofilter geen gegevens opleverd, als dan de kopieeractie uitgevoerd wordt, worden alle gegevens gekopieerd dus ook diegene met Type O en gekopieerd J, waardoor alles dubbel staat.
Ik heb in de macro code een stuk opgenomen waardoor bij een error de kopieeractie niet doorgaat, maar ik vermoed dat een autofilter zonder gegegevens geen error oplevert en er dus niet overgegaan wordt op de errhandler.
Indien de autofilter geen gegevens oplevert zou er gewoon een boodschap moeten verschijnen waarna de rest van de uitvoering stopt.
Ik krijg het probleem echter niet opgelost, dus hopenlijk weet er iemand raad


De macro code die gebruikt wordt is de volgende:

Sub Kopieer_gescoord()

Worksheets("PRL").Activate

'Beveiliging opheffen

Sheets("gewonnen Proj").Unprotect _
Password:="K9iL3uxBNBX"

'Alle veborgen kolommen zichtbaar maken

Sheets("PRL").Columns("A:V").EntireColumn.Hidden = False
Sheets("gewonnen proj").Columns("A:V").EntireColumn.Hidden = False

On Error GoTo Errhandler

'Te kopieren data bepalen

 Worksheets("PRL").Activate
 
 Range("PRL_data").AutoFilter Field:=16, Criteria1:="G"
 Range("PRL_data").AutoFilter Field:=24, Criteria1:="N"
 
' Data kopieren naar eerste vrije cel in werkblad gewonnen proj

Range("PRL_DATA_COPY").Copy Sheets("Gewonnen proj").Range("A65535").End(xlUp).Offset(1)

 Worksheets("PRL").Activate
 
    ActiveSheet.ShowAllData  'zet filters terug
 
 Range("PRL_data").AutoFilter Field:=16, Criteria1:="O"
 Range("PRL_data").AutoFilter Field:=24, Criteria1:="N"
  

'Standaard verborgen kolommen opnieuw instellen

Sheets("gewonnen proj").Columns("G:G").EntireColumn.Hidden = True
Sheets("gewonnen proj").Columns("Q:Q").EntireColumn.Hidden = True

'Data sorteren

 Worksheets("gewonnen proj").Activate

Range("GPRL_data").Select
    ActiveWorkbook.Worksheets("gewonnen proj").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("gewonnen proj").Sort.SortFields.Add Key:=Range("GPRL_PROV"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("gewonnen proj").Sort
        .SetRange Range("GPRL_data")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With


'Beveiliging opnieuw instellen

Sheets("gewonnen Proj").Protect _
Password:="K9iL3uxBNBX", _
UserInterfaceOnly:=True, _
AllowFiltering:=True, _
AllowSorting:=True, _
AllowFormattingColumns:=True
 
 
 Exit Sub
 
Errhandler:

MsgBox "Er zijn geen gescoorde projecten teruggevonden die nog niet gekopieerd werden "
Range("PRL_data").AutoFilter Field:=16, Criteria1:="O"
Range("PRL_data").AutoFilter Field:=24, Criteria1:="N"


End Sub

 

[snb]

Sub Kopieer_gescoord()
  with Sheets("gewonnen Proj")
    .Unprotect "K9iL3uxBNBX"
    .Columns.Hidden = False

    with sheets("PRL").cells(1).currentregion.resize(,24)
       .parent.Columns.Hidden = False
       .AutoFilter 16, "G", xlor ,"O"
       .AutoFilter 24, "N"
       If .columns(1).specialcells(12).count>1 then .Copy Sheets("gewonnen Proj").cells(rows.count,1).End(xlUp).Offset(1)
       .autofilter
       .sort .parent.Range("GPRL_PROV")
    end with

    .Columns("G:G,Q:Q").Hidden = True
    .Protect "K9iL3uxBNBX",True,True,True, True
  end with
End Sub

Een dynamisch benoemd gebied is een hulpmiddel voor de userinterface.Als je met VBA werkt zijn er ingebouwde dynamsiche gebieden: usedrange,currentregion, area, etc.