Regels verwijderen als cel leeg is

Status
Niet open voor verdere reacties.
1

1965Peter

Gebruiker
Lid geworden
20 jun 2016
Berichten
197
Hallo,
Welke vba formule kan ik tussen een bestaande macro plakken, bij het verwijderen van regels?

Bereik is van "i20 t/m i1000" als binnen dit bereik er een lege cel in kolom '"i" is, dan regel verwijderen.

Daarna:

Bereik is van "a20 t/m a1000" als binnen dit bereik er een lege cel in kolom "a" is, dan regel verwijderen.

Bij voorbaat dank
 

Bijlagen

  • Regels verwijderen.xlsx
    46,7 KB · Weergaven: 53
Zoiets?
Code: 
Sub dotchie()
Dim myRgA As Range
Dim myRGI As Range
Set myRGI = Range([I20].End(xlDown), [I1000].End(xlUp))
For Each Cell In myRGI
If IsEmpty(Cell) Then
Cell.EntireRow.Delete
Set myRgA = Range([A20].End(xlDown), [A1000].End(xlUp))
For Each Cell In myRgA
If IsEmpty(Cell) Then
Cell.EntireRow.Delete
End Sub
 
Hallo Philiep, als ik deze er tussenplak, dan loopt ie vast op "For Each Cell In"
 
Code: 
Sub dotchie()
Dim myRgA As Range
Dim myRGI As Range
Set myRGI = Range([I20].End(xlDown), [I1000].End(xlUp))
For Each Cell In myRGI
  If IsEmpty(Cell) Then Cell.EntireRow.Delete
Next Cell
Set myRgA = Range([A20].End(xlDown), [A1000].End(xlUp))
For Each Cell In myRgA
  If IsEmpty(Cell) Then Cell.EntireRow.Delete
Next Cell
End Sub

Werkt dat wel? Uiteraard uitproberen op een kopie van het originele Excel bestand.

Tijs.
 
Zo loopt hij bij mij als een trein
Code: 
Sub dotchie()
Dim myRgA As Range
Dim myRGI As Range
Set myRGI = Range([I20].End(xlDown), [I1000].End(xlUp))
For Each Cell In myRGI
If IsEmpty(Cell) Then Cell.EntireRow.Delete
Next Cell
Set myRgA = Range([A20].End(xlDown), [A1000].End(xlUp))
For Each Cell In myRgA
If IsEmpty(Cell) Then Cell.EntireRow.Delete
Next Cell
End Sub
 
Kolom i loopt op regel 251 & 275 na, daar blijft op de één of andere reden een lege regel tussen.
Na kolom i , zou die de lege regels weg moeten halen als de cel van A leeg is. (zie bijlage)
 

Bijlagen

  • Regels verwijderen2.xlsm
    39,9 KB · Weergaven: 56
Misschien zo

Code: 
Sub VenA()
On Error Resume Next
With Blad3.Range("A20:I" & UsedRange.Rows.Count)
    .Columns(9).SpecialCells(4).EntireRow.Delete
    .Columns(1).SpecialCells(4).EntireRow.Delete
End With
End Sub
 
VenA, deze doet niets, ben helaas een dummy wat vba betreft? of moet deze toegevoegd worden aan die van dotchie?
 
Oeps foutje.

Code: 
Sub VenA()
On Error Resume Next
With Blad3.Range("A20:I" & [COLOR="#FF0000"]blad3.[/COLOR]UsedRange.Rows.Count)
    .Columns(9).SpecialCells(4).EntireRow.Delete
    .Columns(1).SpecialCells(4).EntireRow.Delete
End With
End Sub
 
VenA, hij werkt, alleen als ik een kopie maak van het werkblad, dan doet ie het weer niet, moet ik iets veranderen dan in de vba code?
ik moet dit nl in verschillende tabbladen met verschillende namen doen.
 
Dat lijkt mij wel. Nu wordt er alleen iets gedaan met een werkblad dat de codenaam Blad3 heeft.;)

Je kan er zoiets van maken
Code: 
Sub VenA()
On Error Resume Next
For Each sh In Sheets(Array("naam blad1", "naam blad2"))
    With sh.Range("A20:I" & sh.UsedRange.Rows.Count)
        .Columns(9).SpecialCells(4).EntireRow.Delete
        .Columns(1).SpecialCells(4).EntireRow.Delete
    End With
Next sh
End Sub
 
Het werkt wel als ik een kopie van de tab hebt gemaakt en blad3 in blad4 verander in de vba code.
op zich gaat het hiermee denk ik wel lukken, ik ga 'm in mijn officiele bestand proberen. Mocht dat niet lukken, kom ik nog terug.
In ieder geval bedankt voor alle hulp!!
 
VenA, Ik kom er toch niet uit met jouw formule, Denk issue met het toewijzen van benoemde tabbladen. Ik heb de file zoals ie bestaat toegevoegd.
Het gele gedeelte zou de macro moeten worden, die plak tussen het restant van de macro.
 

Bijlagen

  • Test SE.xlsm
    93,5 KB · Weergaven: 60
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan