Regels verwijderen / formules omzetten waarde

[MuM111]

Na bijna alle forumberichten mbt verwijderen lege regels te hebben doorgenomen, toch nieuw bericht toegevoegd omdat het niet wil werken.
Bijgevoegd bestand waar max 26 regels in komen.
In deze regels staan verwijzingen / formules.
Nu moet het zo zijn dat alle formules omgezet worden naar waarden en dat de lege regels ook daadwerkelijk verwijderd worden.
Dit is namelijk een importbestand om tekeningen te genereren en er moet echt een lege regel zijn.

Als ik dit handmatig doe dan is het voldoende om de eerste lege regel te selecteren en dan met Delete-knop de regel leeg te maken,
dit werkt prima maar ik wil het automatiseren.

    Auft = ActiveWorkbook.Sheets("AB-JVA").Range("D8").Value
    Sheets("OutputWinkel").Select
    Sheets("OutputWinkel").Copy
    
    Dim b As Range, rows As Long, i As Long
    Set b = Range("A2:D20")
    rij = b.rows.Count
    For i = rij To 1 Step (-1)
       If WorksheetFunction.CountA(b.rows(i)) = 0 Then b.rows(i).Delete
    Next

    Range("A2:N26").Select
    Selection.Copy
    Range("A2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A2").Select
    
    ActiveWorkbook.SaveAs Filename:= _
        "\\Dkg-av1\trumpf_pdm2\TRUMPF.NET\Workfiles\GEO-Dateien\auftragsbezogene Teile\Jahr " & Format(Date, "yyyy") & "\" & Auft & "\" & Auft & " winkel.xls"
    ActiveWindow.Close
    Sheets("Winkel").Select

Bvd voor jullie hulp.

 

[r3000]

Werkt dit voor je?

Sub r3000()

Dim i As Integer
Dim y As Integer
i = ActiveSheet.UsedRange.rows.Count
For y = i To 1 Step -1
    If Cells(y, 2).Value = "" Then
       Cells(y, 2).EntireRow.Delete
    End If
Next

End Sub

 

[MuM111]

Dit werkt prima.

Bedankt :thumb:

 

[r3000]

deze werkt beter (niet van mij maar gevonden op ander forum)

Sub delblankrows()

Dim s1 As Worksheet
Dim tmpR As Range
Dim rowcount As Long, colcount As Long, i As Long, j As Long, k As Boolean

'Change "Blad1" to the name of your worksheet.
Set s1 = Sheets("Blad1")
Set tmpR = s1.UsedRange
rowcount = tmpR.Rows.Count
colcount = tmpR.Columns.Count

'Starts from bottom row and looks for non-empty cells from left to right.
'Moves to row above if non-empty cell is found.
'If none is found, then deletes row and shifts values up.
For i = rowcount To 1 Step -1
    k = 0
    For j = 1 To colcount
        If tmpR.Value2(i, j) <> "" Then
            k = 1
            Exit For
        End If
    Next j
    If k = 0 Then
        tmpR.Rows(i).Delete Shift:=xlUp
    End If
Next i

End Sub

 

[snb]

Sub M_snb()
  usedrange.value=usedrange.value
  columns(1).specialcells(4).entirerow.delete
end Sub

 

[MuM111]

deze werkt beter (niet van mij maar gevonden op ander forum)

Geeft niet, ik "leen" ook alles bij elkaar tot macro werkt
Hij werkt goed, in ieder geval bedankt hiervoor.