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


Reply With Quote

