VBA - macro draait 1 keer, 2e keer stopt deze halverwege

[Bastiaans90]

Goedemiddag,

Ik heb een macro toegevoegd aan een Excel-bestand. Als ik de macro voor de eerste keer uitvoer dan gaat dit helemaal goed en krijg ik precies wat ik verwacht. Als daarna de macro nog een keer uitvoer dan krijg ik een foutmelding en stopt de macro halverwege. Als ik ,voordat ik de de macro voor de tweede keer start uitvoer, op beginwaarden druk in de VBA-editor dan werkt de de macro wel weer zoals die hoort te werken. Weet iemand wat het probleem is? Onderstaande VBA-code gebruik ik.

Sub macro_starten()

    Sheets("Sheet 1").Range("A4:G1200").ClearContents
    Sheets("Sheet 1").Range("A4:G499").Value = Sheets("Sheet 2").Range("T5:Z500").Value
    
Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets("Sheet 1")
    ws.Range("A3:F1000").AutoFilter Field:=2, Criteria1:="ABC"
    Application.DisplayAlerts = False
    ws.Range("A4:F1000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = False
    
    Set ws = ThisWorkbook.Worksheets("Sheet 1")
    ws.Range("A3:F1000").AutoFilter Field:=2, Criteria1:="DEF"
    Application.DisplayAlerts = False
    ws.Range("A4:F1000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = False
    
    Set ws = ThisWorkbook.Worksheets("Sheet 1")
    ws.Range("A3:F1000").AutoFilter Field:=2, Criteria1:="GHI"
    Application.DisplayAlerts = False
    ws.Range("A4:F1000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = False
    
    Set ws = ThisWorkbook.Worksheets("Sheet 1")
    ws.Range("A3:F1000").AutoFilter Field:=2, Criteria1:=""
    Application.DisplayAlerts = False
    ws.Range("A4:F1000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = False
    
    Sheets("Sheet 1").AutoFilterMode = False

    Dim LR As Long
    LR = Sheets("Sheet 1").Range("A1").SpecialCells(xlCellTypeLastCell).Row + 1
    Sheets("Sheet 3").Range("W2:AB500").Copy
    Sheets("Sheet 1").Range("B" & LR).PasteSpecial xlPasteValues
    Application.CutCopyMode = False
    
    Sheets("Sheet 1").Range("C4:C1500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
Dim wss As Worksheet
    Set wss = ThisWorkbook.Worksheets("Sheet 1")
    wss.Range("A3:F1000").AutoFilter Field:=2, Criteria1:="XYZ"
    Application.DisplayAlerts = False
    wss.Range("A4:F1000").SpecialCells(xlCellTypeVisible).Delete
    Application.DisplayAlerts = False
    
    Sheets("Sheet 1").AutoFilterMode = False
    
    Sheets("Sheet 1").Range("C4:C1500").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    
    Sheets("Sheet 1").Columns("E:E").NumberFormat = "# ?/?"
    Sheets("Sheet 1").Columns("F:G").NumberFormat = "$#,##0.00_);($#,##0.00)"
    Sheets("Sheet 1").Columns("A:E").HorizontalAlignment = xlLeft
    
    Sheets("Sheet 1").Activate
    ActiveSheet.Cells(1, 1).Select


End Sub

Alvast bedankt voor jullie hulp

Groetjes,

Bastiaan

 

[edmoor]

Ik blijf het vreemd vinden dat wanneer iemand zegt een foutmelding te krijgen, deze er niet bij wordt verteld.
En welke regel is "halverwege"?

Daarnaast kan je code een stuk eenvoudiger.

 

[Bastiaans90]

De foutmelding "Fout 1004 tijdens uitvoering: Er zijn geen cellen gevonden." krijg ik bij regel 11 (ws.Range("A4:F1000").SpecialCells(xlCellTypeVisible).Delete). Hoe kan de code een stuk eenvoudiger? Door het gebruik van deze macro voegt hij twee lijsten samen in 'sheet 1'. Vervolgens wordt de nieuwe lijst in sheet 1 gefilterd op bepaalde waarden.

 

[VenA]

Bij het autofilter is het niet nodig om te kijken naar zichtbare rijen. De foutmelding komt omdat er geen zichtbare rijen meer zijn bij de 2e keer dat je de macro uitvoert. Die heb je namelijk bij de eerste keer al verwijderd.

 

[Bastiaans90]

Dankjewel voor je reactie en je hulp. Het probleem is opgelost. Het had inderdaad te maken met de zichtbare rijen.