Kleines Lagerbuch

Hallo,
ich bräuchte Unstützung bei meinem kleinen Lagerbuch.
Ich bräuchte eine Funktionalität bei der die Zeilen von A bis U aus dem Tabellenblatt "Pulverbuch" ins Tabellenblatt "Buchungen" in die nächste freie Zeile kopiert werden. Dieser Copy soll bei den Zeilen ausgeführt werden welche die Spalte V gefüllt haben, dabei soll allerdings der Wert aus V den Wert in J im Tabellenblatt "Buchungen" überschreiben. Toll wäre es auch noch, wenn man den Wert aus W in das andere Tabellenblatt übernehmen könnte.
Leider bekomme ich das via Makrorecorder nicht realisiert. Es wäre schön, wenn jemannd für mich einen Ansatz hätte.
Eine Beispieldatei habe ich hier hinzugefügt:
https://www.herber.de/bbs/user/89209.xlsm
Vorab vielen Dank.
LG
Sascha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub kopieren() Dim wksPulver As Worksheet, i Set wksPulver = Sheets("Pulverbuch") Application.ScreenUpdating = False For i = 3 To wksPulver.Cells(Rows.Count, 1).End(xlUp).Row wksPulver.Range(wksPulver.Cells(i, 1), wksPulver.Cells(i, 21)).Copy With Sheets("Buchungen") .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteFormats .Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:=xlPasteValues .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 10) = wksPulver.Cells(i, 22).Value .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 22) = wksPulver.Cells(i, 23).Value End With Next Application.CutCopyMode = False Application.ScreenUpdating = False End Sub

Sub ScreenUpdating_test() MsgBox Application.ScreenUpdating 'Zustand prüfen Application.ScreenUpdating = False 'ausschalten MsgBox "ok" MsgBox Application.ScreenUpdating 'Zustand nochmal prüfen End Sub

das hat ich ja ganz übersehen/vergessen ^^

Sub kopieren()
Dim wksPulver As Worksheet, i
Set wksPulver = Sheets("Pulverbuch")
Application.ScreenUpdating = False
For i = 3 To wksPulver.Cells(Rows.Count, 1).End(xlUp).Row
If wksPulver.Cells(i, 22).Value  "" Then
wksPulver.Range(wksPulver.Cells(i, 1), wksPulver.Cells(i, 21)).Copy
With Sheets("Buchungen")
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:= _
xlPasteFormats
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).PasteSpecial Paste:= _
xlPasteValues
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 10) = wksPulver.Cells(i, 22).Value
.Cells(.Cells(Rows.Count, 1).End(xlUp).Row, 22) = wksPulver.Cells(i, 23).Value
End With
End If
Next
Application.CutCopyMode = False
Application.ScreenUpdating = False
End Sub

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread