erste leere ZELLE in Bereich (flexibel)

Hallo an alle EXCEL-Spezialisten,
habe mal wieder ein VBA-Problem, das ich nicht gelöst bekomme u. suche ein Makro für den CommandButton "Ziel-2 / Bereich1" aus der UF (s. Blatt 'Quelle'):
Ich habe im Blatt 'Ziel-2' in A4 den Text "Beginn1" u. in A7 "Ende1" - diese sollen sozusagen als Beginn- u. Endemarken für den Code dienen.
Zwischen diesen beiden Marken soll nun das Makro folgendes bewerkstelligen:
1. Suche die erste leere ZELLE in diesem Bereich (also in diesem Fall A4:A7; gefunden wird A5).
Ist die darunterliegende Zelle (also hier A6) ebenfalls leer, dann: Markiere die ZELLE A5.
Ist die darunterliegende Zelle (also hier A6) nicht leer, dann: Markiere diese ZELLE (also A6).
2. Markiere die gesamte ZEILE u. füge eine neue Zeile ein.
3. Markiere nun die erste leere ZELLE in dem neuen Bereich (nun A4:A8; gefunden wird A5).
Um das Problem besser zu veranschaulichen, habe ich eine Beispielmappe vorbereitet:
https://www.herber.de/bbs/user/49525.xls
Ich freue mich auf eure Ideen u. Lösungsvorschläge !
MfG Dirk N.
P.S.: Hier noch eine andere Beschreibung , die wohl aber nicht zum gewünschten Ergebnis führen wird - es wird IMMER eine neue Zeile eingefügt:
1. Suche die letzte leere ZELLE in diesem Bereich (also in diesem Fall A4:A7; gefunden wird A6).
2. Markiere die gesamte ZEILE u. füge eine neue Zeile ein.
3. Markiere nun die erste leere ZELLE in dem neuen Bereich (nun A4:A8; gefunden wird A5).
SONDERFALL: Beim 1. Makrostart sind ja A5 u. A6 noch leer (also letzte UND erste leere ZELLE in dem Bereich zwischen den Beginn- u. Endemarken sind beide leer).
NUN soll nur die erste leere ZELLE markiert werden.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Dirk,
hier mein Vorschlag für den Button-Code.
Gruß
Franz


Private Sub CommandButton4_Click()  'Ziel-2 / Bereich1
Dim wks As Worksheet
Dim rngBeginn As Range, rngEnde As Range, rngLeer As Range
Dim varBeginn As Variant, varEnde As Variant
Dim lZaehler As Long
varBeginn = "Beginn1"
varEnde = "Ende1"
Set wks = Worksheets("Ziel-2")
With wks
.Activate
'Beginn des Bereichs finden
Set rngBeginn = .Columns(1).Find(what:=varBeginn, LookIn:=xlValues, lookat:=xlWhole)
If rngBeginn Is Nothing Then
MsgBox varBeginn & " in Spalte A nicht gefunden!"
Exit Sub
End If
'Ende des Bereichs finden
Set rngEnde = .Columns(1).Find(what:=varEnde, LookIn:=xlValues, lookat:=xlWhole)
If rngEnde Is Nothing Then
MsgBox varEnde & " in Spalte A nicht gefunden!"
Exit Sub
End If
'1. leere Zelle im Bereich finden
Do
lZaehler = lZaehler + 1
Set rngLeer = rngBeginn.Offset(lZaehler, 0)
Loop Until rngLeer.Value = rngEnde.Value Or IsEmpty(rngLeer)
If IsEmpty(rngLeer) Then
If IsEmpty(rngLeer.Offset(1, 0)) Then
If rngEnde.Row - rngBeginn.Row = 3 Then
'2 leere Zeilen zwischen Beginn und Ende zu Beginn
rngLeer.Select
Else
rngLeer.EntireRow.Insert shift:=xlShiftDown
rngLeer.Offset(-1, 0).Select
End If
Else
rngLeer.Offset(1, 0).EntireRow.Insert shift:=xlShiftDown
rngLeer.Select
End If
Else
MsgBox ("Achtung, keine freie Zeile im Bereich " & .Range(rngBeginn.Offset(1, 0), _
rngEnde.Offset(-1, 0)).Address & " vorhanden." & vbCr & _
"Es kann nicht eingefügt werden !!")
End If
End With
Set wks = Nothing: Set rngBeginn = Nothing: Set rngEnde = Nothing: Set rngLeer = Nothing
Unload Me
End Sub

If IsEmpty(rngLeer) Then If IsEmpty(rngLeer.Offset(1, 0)) Then If rngEnde.Row - rngBeginn.Row > 3 Then '*** '2 leere Zeilen zwischen Beginn und Ende zu Beginn rngLeer.Select Else rngLeer.EntireRow.Insert shift:=xlShiftDown rngLeer.Offset(-1, 0).Select End If Else rngLeer.Offset(0, 0).EntireRow.Insert shift:=xlShiftDown '*** rngLeer.Select End If

Im Modul2 zusätzliche Variable deklarieren: Option Explicit Public PrevSheet As Worksheet Public Auswahl As Range 'Selektierte Zellen im Blatt Quelle Sub JumpToPrevSheet() If Not PrevSheet Is Nothing Then PrevSheet.Activate End Sub Code für Button im Blatt Quelle: Private Sub CommandButton1_Click() Set Auswahl = Selection UserForm1.Show End Sub Code für Commandbutton2 im Blatt Ziel-2: Private Sub CommandButton2_Click() 'Werte einfügen If Not Auswahl Is Nothing Then Auswahl.Copy Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Application.CutCopyMode = False Set Auswahl = Nothing Else MsgBox "Es wurden keine zu kopierenden Werte ausgewählt!" End If End Sub

Beliebteste Forumthreads (12 Monate)

erste leere ZELLE in Bereich (flexibel)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

erste leere ZELLE in Bereich (flexibel)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread