Lege cel in reeks zoeken

Status
Niet open voor verdere reacties.
B

bomseler

Gebruiker
Lid geworden
31 aug 2016
Berichten
53
Beste forumleden,

Ik ben op zoek naar een macro die het volgende doet:

Ik wil met behulp van een inputbox o.i.d. een cel vullen in een reeks. Ik heb wel de manier gevonden om de eerste cel in de reeks te selecteren (zie voorbeeldbestand). Nu het volgende, ik wel de macro laten checken of de cel leeg is, zo niet, dan moet deze naar de volgende cel in de reeks selecteren.

En de volgende stap. Stel dat de reeks vol is (omlijnde gedeelte), dan moet hij de volledige rij kopiëren (incl. formules) en invoegen in de reeks zodat deze langer wordt.

Ik hoor graag als iemand mij hiermee kan helpen, in ieder geval het eerste deel dan kan ik zelf weer een stapje verder (A). Alvast hartelijk dank.


Bekijk bijlage TEST lege cel.xlsm
 
Met de vermenigvuldiging in de code i.p.v. je formule in kolom D.
Code: 
Sub TESTLEEG()
Dim getal
getal = Application.InputBox("voer een getal in", , , , , , , 1)
If getal <> False Then Cells(Application.Max(24, Cells(Rows.Count, 3).End(xlUp).Row + 1), 3).Resize(, 2) = Array(getal, getal * 5)
End Sub
 
HSV zei:
Met de vermenigvuldiging in de code i.p.v. je formule in kolom D.
Code: 
Sub TESTLEEG()
Dim getal
getal = Application.InputBox("voer een getal in", , , , , , , 1)
If getal <> False Then Cells(Application.Max(24, Cells(Rows.Count, 3).End(xlUp).Row + 1), 3).Resize(, 2) = Array(getal, getal * 5)
End Sub
Klik om te vergroten...

Je moet eigenlijk niet naar de formules kijken. Het gaat erom dat de gegevens ingevuld worden in de eerste cel en als deze gevuld is in de volgende.

Ik heb het geprobeert met end.xldown maar dan ga ik naar de laatste rij in het blad.

Dus een check of de cel gevuld is, zo ja, dan een offset naar beneden en de check opnieuw.
 
bomseler zei:
Ik heb het geprobeert met end.xldown maar dan ga ik naar de laatste rij in het blad.
Klik om te vergroten...

Tja...., als je mijn code had geprobeerd was dat niet gebeurd.
 
Code: 
    ActiveSheet.Cells.Find("TEST").Select
    Selection.Offset(2, 0).Select
    
    If ActiveCell.Value <> False Then
        ActiveSheet.Cells.Find("TEST").Select
        Selection.End(xlDown).Offset(1, 0).EntireRow.Select
        Selection.Copy
        Selection.Insert Shift:=xlUp
        Application.CutCopyMode = False
    End If

Ik heb het nu op deze manier opgelost.

Topic kan gesloten worden.
 
Om hulp vragen, en dan ******eigenwijs een slechte code met tig overbodige selects en selections plaatsen.
Ik hoop niet dat deze code door iemand gebruikt gaat worden.

Op slot zetten moet jezelf even doen
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan