automatisch zeilen einfügen

Hallo!
ich habe in meiner Arbeitsmappe 2 tabellenblätter. Das erste tabellenblatt bisitz in der Spalte A eine Abfolge von Positionsnummer. Diese werden in das 2. tabellenblatt kopiert.
nun zu meinen eigentlichen problem: die Positionsnummern sind unterschiedlich lang. Und vor der kürzesten nummer sollen 2 leerzeilen eingefügt werden.
d.h., wenn der die Länge des Inhaltes einer Zelle kleiner ist als der vorangegangen zellenwert und auch der nachfolgende, dann sollen vor diese zeile 2 leere zeilen eingefügt werden. Außerdem soll der wert in der Spalte f, eine zeile unter dieser Zelle steht null sein.
ist dies mit vba möglich?
zum besseren verständnis habe ich eine tabelle angefügt, die mein problem besser verdeutlichen soll. In dem tabellenblatt1 stehen die daten die übernommen werden sollen und in tabelle2 ist der zustand, den ich erreichen möchte.
https://www.herber.de/bbs/user/50386.xls
vielen dank für eure hilfe
Gruß Mandy

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo zusammen!!
da mir bis jetz leider noch niemand helfen konnte, habe ich selbst versucht etwas zu progrmmieren. leider
mit mäßigem erfolg.
Also was ich mit diesem Quelltext machen möchte:
zuerst will ich auf dem kompletten Arbeitsblatt, nach der zu letzt beschriebenen Zeile suchen.
Danach sollen in den ersten 3 spalten der jeweiligen Spalte gesucht werden, ob der wert in Spalte A großer Null ist und B und C Null sind. Ist
dies der Fall, soll vor die betreffende Zeile eine weitere Zeile eingefügt werden.
Das ganze soll solang durchgeführt werden, bis die letzte beschrieben Zeile errericht ist.
Leider funktioniert mir nur die suche nach der letzten beschriebenen Zeile nicht aber das einfügen der zeile.
Kann mir vielleicht einer sagen, wo genau der Fehler in meinen Quelltext liegt?
Gruß Mandy


Private Sub Zeinfuegen_Click()
Dim objWks As Worksheet
Dim nLastRow As Integer
Dim strMsg As String
Dim zl As Integer
Set objWks = ActiveWorkbook.Worksheets(1)
With objWks
If Application.WorksheetFunction.CountA(.Cells) > 0 Then
On Error Resume Next
nLastRow = .Cells.Find(what:="*", after:=.Cells(1), LookIn:=xlFormulas, lookat:=xlWhole,  _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
If Err.Number = 0 Then
strMsg = "Letzte Zeile mit Daten: " & nLastRow
End If
MsgBox (nLastRow)
On Error GoTo 0
End If
End With
For zl = 8 To nLastRow
zl = 8
Do While zl  "" And Cells(zl, 2) = "" And Cells(zl, 3) = "" Then
With Sheets("tab")
Rows(zl).Select
Selection.Insert Shift:=xlDown
End With
Else: Err.Clear
End If
Loop
Next
zl = zl + 1
End Sub

Sub Klick() Dim r1 As Long, r2 As Long, rr As Long r1 = Cells(1, 3).End(xlDown).Row r2 = Cells(r1, 3).End(xlDown).Row For rr = r2 To r1 Step -1 If Len(Cells(rr - 1, 3)) > Len(Cells(rr, 3)) And _ Len(Cells(rr + 1, 3)) > Len(Cells(rr, 3)) Then Rows(rr & ":" & rr + 1).Insert End If Next End Sub

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread