Zeilen von Sheet zu Sheet verschieben

Hallo zusammen!
Über eine Userform werden Daten eingegeben. Diese werden im Sheet Eingang in die letzte freie Zeile in die Spalten B-H geschrieben (siehe Beispiel). Dies funktioniert soweit ganz gut.
Zu meinem Anliegen was jetzt meine VBA-Fähigkeiten sprengt:
Die Bauteile verlassen den Bereich irgendwann wieder und sollen nicht gelöscht werden, sondern in das Sheet Ausgang verschoben/ kopiert werden.
Dazu soll in Spalte i die Angabe Ja/ Nein (oder anderes) ausgewählt werden.
Zeilen mit Ja sollten durch Drücken des Buttons Ausgehende Bauteile Verschieben
in das Sheet Ausgang kopiert werden (Spalte B I). Die ursprüngliche Formatierung in G (bedingte Formatierung usw.) sollte erhalten bleiben.
Die entstandenen Lücken sollten durch die darunterliegenden Datensätze wieder geschlossen werden. (nach Möglichkeit kein Zellen noch oben schieben)
Ist dies in einer VBA Lösung nach meinen Vorstellungen möglich? Oder muss eine andere Lösung her? Vielleicht kann mir jemand hier behilflich sein.
Vielen Dank
Gruß
Markus
Link zum Beispiel: https://www.herber.de/bbs/user/83293.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Markus,
vllt. mit diesem Code:

Private Sub cmdAusgang_Click()
Dim ze As Long
Dim lzE As Long
Dim lzA As Long
Dim shE As Worksheet
Dim shA As Worksheet
Set shE = ThisWorkbook.Sheets("Eingang")
Set shA = ThisWorkbook.Sheets("Ausgang")
Application.EnableEvents = False
With shE
.Select
.Range("A2").Select
lzE = .Cells(3, 9).End(xlDown).Row
lzA = shA.Cells(3, 2).End(xlDown).Row + 1
For ze = lzE To 3 Step -1
If LCase(.Cells(ze, 9)) = "ja" Then
.Range(Cells(ze, 2), Cells(ze, 9)).Copy Destination:=shA.Cells(lzA, 2)
.Range(Cells(ze, 2), Cells(ze, 9)).ClearContents
lzA = shA.Cells(3, 2).End(xlDown).Row + 1
End If
Next
End With
shE.Range("B2:I" & lzE).Select
shE.Sort.SortFields.Clear
shE.Sort.SortFields.Add Key:=Range("B3:B" & lzE) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With shE.Sort
.SetRange Range("B2:I" & lzE)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
shE.Range("A3").Select
Application.EnableEvents = True
End Sub

Gruß
Jochen

Sub Verschieben() Dim wksDst As Worksheet Dim i As Long Dim lngLR As Long Const FIRSTROW As Long = 3 Set wksDst = ThisWorkbook.Sheets("Ausgang") With ThisWorkbook.Sheets("Eingang") For i = FIRSTROW To .Cells(.Rows.Count, 1).End(xlUp).Row If LCase(.Cells(i, 9).Text) = "ja" Then lngLR = wksDst.Cells(wksDst.Rows.Count, 2).End(xlUp).Row wksDst.Cells(lngLR + 1, 2).Resize(, 8).Value = _ .Cells(i, 2).Resize(, 8).Value .Cells(i, 2).Resize(79 - i + FIRSTROW - 1, 8).Value = _ .Cells(i + 1, 2).Resize(79 - i + FIRSTROW - 1, 8).Value i = i - 1 End If Next End With Set wksDst = Nothing End Sub

Beliebteste Forumthreads (12 Monate)

Zeilen von Sheet zu Sheet verschieben

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

143 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen von Sheet zu Sheet verschieben

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

143 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