Hi,

Probably I’m doing something wrong with my code. I’ve an IF and Else statement that’s working fine. But when it’s an Else the macro goes to the follow macro. That’s also working fine. But when he finished the next macro he goes back to the first macro and starts after the End IF statement. But I expect that the macro will end at the end of the second macro.

Do I something wrong in the code?

Thanks,
Peter

Sub SanneSprint30()
 
Dim NewRng As Long
    NewRng = Blad1.Range("B" & Rows.Count).End(xlUp).Row
Dim rFiltered As Range
 
 
'filter aanzetten
 
    Sheets("Data").Select
    Rows("5:5").Select
    Selection.AutoFilter
   
 
 
Set rFiltered = ActiveSheet.AutoFilter.Range
 
'geeft aan welke kolom je gaat filteren en wat de filter criteria is
 
    With Range("$A$5:$BC" & NewRng)
        .AutoFilter Field:=Sheets("Waarden").Range("B34"), Criteria1:="<>"
       
   
'als er geen filter resultaat is dan kan er niets gekopieerd worden e nloopt het programma vast
'daarom wordt hier gekeken of er minder dan 1 resultaat is
'als dit zo is gaat hij naar de volgende macro
'is dit wel zo dan gaat hij verder met het kopieerten van het resultaat
       
  If .Columns(1).SpecialCells(xlCellTypeVisible).Count > 1 Then
 
 
'hier gaat hij de kolommen kopieeren en plakken op het tabblad Overzicht
   
    rFiltered.Offset(1, 0).Resize(rFiltered.Rows.Count - 1).Columns("A:C").SpecialCells(xlCellTypeVisible).Copy
    Sheets("Overzicht").Select
    Range("B10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("Data").Select
    rFiltered.Offset(1, 0).Resize(rFiltered.Rows.Count - 1).Columns("GZ").Copy
    Sheets("Overzicht").Select
    Range("E10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
 
'hier gaat hij naar de volgende macro als er geen resultaten zijn
'hij zet ook eerst de filter weer uit, anders gaat de volgende macro mis
   
    Else
    Sheets("Data").Select
    Selection.AutoFilter
    SanneSprintEnd
   
   
    End If
    End With
   
'hier gaan we de tekst sprint X toevoegen
   
    Range("F10").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    Do Until IsEmpty(ActiveCell.Offset(0, -4).Value)
    ActiveCell.Value = Sheets("Waarden").Range("A13")
    ActiveCell.Offset(1, 0).Select
    Loop
   
'hier gaan we de tekst sprint X toevoegen
   
    Sheets("Data").Select
    Selection.AutoFilter
  
   
End Sub
 
Sub SanneSprintEnd()
 
 
     
    Sheets("Overzicht").Select
    Range("A1").Select
   

 
End Sub