Regels naar boven opschuiven ingeval tussenliggende lege regels

Status
Niet open voor verdere reacties.

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
901
Beste Helpmij'ers,

Kan iemand mij helpen met een code die gevulde regels (binnen een bereik) onder elkaar zet wanneer er lege regels tussen staan, zonder dat de regels verwijderd worden? Bovendien dient de volgorde in stand blijven.

Ik heb al een opzetje gemaakt.

Code:
 Sub test()
    For Each cl In Range("C1:C17")
    If cl.Value = "" Then cl.Value = .......: Exit For
    Next cl
 End Sub

Alvast hartelijk dank.

RobertBekijk bijlage Opschuiven.xlsm
 
Laatst bewerkt:
Kan het iets concreter?
 
Ja hoor... In het bijgeleverde bestand staan in kolom C een aantal getallen en daartussen zitten lege cellen. Ik zou graag dat alle getallen aaneengesloten worden vanaf cel C1 (dit had ik idd niet verteld, sorry). Het kan ook voorkomen dat er geen getallen staan maar andere leestekens, het effect dient dan hetzelfde te zijn.
 
Zoiets dus.
Code:
Sub test()
Dim sv, arr, i As Long
sv = Range("c1:c17")
arr = sv
n = 1
  For i = 1 To UBound(sv)
    If sv(i, 1) <> "" Then
      arr(n, 1) = sv(i, 1)
      n = n + 1
    End If
  Next i
  Cells(1, 3).Resize(n - 1) = arr
End Sub
 
Code:
Sub test()
Dim sv, arr, i As Long
sv = Range("c1:c17")
arr = sv
  For i = 1 To UBound(sv)
    If sv(i, 1) <> "" Then
       n = n + 1
       arr(n, 1) = sv(i, 1)
    End If
  Next i
  Cells(1, 3).Resize(17).ClearContents
  Cells(1, 3).Resize(n) = arr
End Sub
 
Is dit niet voldoende?
Code:
Sub VenA()
  Columns(3).SpecialCells(4).Delete
End Sub
 
Er worden ook geen regels verwijderd @HSV alleen de lege cellen in kolom C. Dit geeft in dit gebrekkige voorbeeldbestand, los van het zwarte streepje aan de onderkant van C17, hetzelfde resultaat als jouw code. Het kan natuurlijk een belangrijk streepje zijn:)
 
Je hebt gelijk.
Die code was ook mijn eerste ingeving, maar door het zinnetje naar een ander gedachte geswitcht.

Misschien is het streepje toch erg belangrijk.
 
hahaha...het was idd een belangrijk streepje, want als de code de cellen verwijderd komen de cellen naar boven toe en dat was precies niet mijn bedoeling. Toch fijn dat je jullie ondanks dat ik deze op opgelost heb gezet toch de moeite hebben genomen om er naar te kijken...heel hartelijk dank...
 
Als helpers leren wij graag van elkaar. Dus ook als een draadje al als opgelost staat gaan we nog wel eens verder om te bekijken of het eventueel eenvoudiger/korter (niet perse beter) kan.

Met lijntje terug.;)

Code:
Sub VenA()
  Columns(3).SpecialCells(4).Delete
  Cells(17, 3).Borders(xlEdgeBottom).Weight = xlMedium
End Sub
 
Misschien ook nog!
Als er iets verder naar onderen gegevens staan, zullen deze naar boven verschuiven. :d
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan