Thema: Zeiler per VBA in zweites Tabellenbl. verschieben

Hallo zusammen,
ich habe eine Datei mit zwei Tabellenblättern.
Zum einen das Tabellenblatt "Paletten" und zum anderen das BLatt "Archiv".
In Zeile 3 beginnen die Überschrifen...
Filiale / Name / Straße / PLZ / Ort / Colli usw.
Nun will ich gerne das wenn ich im z.B Bereich A4:E20 Werte stehen habe, diese per Button in das Blatt "Archiv" ebenfalls ab Zeile 4 verschoben werden und im Blatt "Paletten" entfernt / gelöscht werden.
Wenn ich nun wieder neue Werte in das Blatt "Paletten" eintrage, sollen diese dann ebenfalls per Klick auf den Button wieder ins Archiv geschoben werden, aber direkt unter den letzten Satz / Zeile des Archivs. Also immer angehangen werden.
Leider bin ich bei Google auf dieverse Lösungen gestoßen die nicht das gemacht haben was sie sollten.
Ich hoffe hier kann mir einer helfen.
mfg

Moin
Sind Fragen offen.
Koennen leere Zeilen im Bereich sein?
In welcher Spalte(Paletten) kann man den letzten Eintrag herleiten?
gruss hary

Hi Hary,
NEiN leere Zeilen sollten dort nicht vorkommen, ich denke es macht aber Sinn dieses mit einzubauen, weil andere damit Arbeiten werden und dann weiß man ja nie.
Leere Zellen werden vorkommen.
Was meinst du herleiten?
Welche die letzte Spalte ist, in der ein Wert steht?
Oh, dass weiß ich jetzt gar nicht so genau.
Das kann man doch aber noch anpassen, oder?

Moin
Um etwas anzuhaengen braucht es eine Spalte wo in den Zellen immer etwas steht. Dann kann man sagen Bsp.: in SpalteA steht immer etwas und da nimm die letzte belegte Zelle + 1 und haenge dran.
Mit UsedRange geht es auch, kann aber in die Hose gehen.
Lad mal eine bsp.-Mappe hoch.
gruss hary

Hallo Hary,
nen bisschen hab ich und ein Freund (Java Entwickler) hinbekommen.
Wir haben es schon mal soweit hinbekommen, dass nur die Werte übertragen werden.
Jedoch haben wir noch das Problem, das wenn wir am Schluss die Zeilen löschen, die SVERWEISE logischer Weise ebenfalls weg sind. Die SVERWEISE in den Spalten B:E sollten vorhanden bleiben oder wieder eingefügt werden.
Auch sollte die Dropdown Box in Spalte G nicht mitkopiert und gelöscht werden.

https://www.herber.de/bbs/user/97823.xlsm

Moin
Probier mal so.

Dim letzte As Long
Dim a As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
For a = 4 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountBlank(wksQ.Cells(a, 1).Resize(1, 7)) < 7 Then
letzte = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksQ.Cells(a, 1).Resize(1, 7)
wksZ.Cells(letzte, 1).Resize(1, 7).Value = .Value '---nur Werte uebertragen
.ClearContents
End With
End If
Next
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")

gruss hary

Hallo Hary,
soweit so gut.
Jedoch sind leider die SVERWEISE ab der Zeile in der man Werte, im Blatt "Paletten" ebenfalls weg.
Diese sollen schon drin bleiben, ohne das man diese immer wieder reinkopieren muss.
Das gleiche sollte dann auch für das Dropdown gelten.

Moin
Dann so.

Dim letzte As Long
Dim a As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
For a = 4 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountBlank(wksQ.Cells(a, 1).Resize(1, 7)) < 7 Then
letzte = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksQ.Cells(a, 1)
wksZ.Cells(letzte, 1).Resize(1, 7).Value = .Resize(1, 7).Value
.ClearContents 'nur SpalteA loeschen
.Offset(0, 6) = "" 'SpalteG leeren
End With
End If
Next
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")

gruss hary

Hallo Hary,
hat geklappt, danke.
Ich habe aber das vorherige genommen und einfach die Formeln wieder mit reinkopiert, falls einer diese löscht.
Vielen Dank für die super Hilfe.

Sub Archiv()
Dim letzte As Long
Dim a As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
For a = 4 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountBlank(wksQ.Cells(a, 1).Resize(1, 9)) < 9 Then
letzte = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksQ.Cells(a, 1).Resize(1, 9)
wksZ.Cells(letzte, 1).Resize(1, 9).Value = .Value '---nur Werte uebertragen
.ClearContents
End With
End If
Next
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
With wksQ
.Range("B4:B100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;2;FALSCH);"" _
"")"
.Range("C4:C100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;3;FALSCH);"" _
"")"
.Range("D4:D100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;4;FALSCH);"" _
"")"
.Range("E4:E100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;5;FALSCH);"" _
"")"
.Range("I4:I100").FormulaLocal = "=WENN($H4="""";"""";ARBEITSTAG($H4;1;WENNFEHLER(SVERWEIS( _
ARBEITSTAG(Paletten!$H4;1)&SVERWEIS(Paletten!$E4;Postleitzahlen!$B:$F;5;FALSCH);Feiertage!$A:$B;2;FALSCH);0)))"
End With
End Sub

Hallo zusammen,
ich habe eine Datei mit zwei Tabellenblättern.
Zum einen das Tabellenblatt "Paletten" und zum anderen das BLatt "Archiv".
In Zeile 3 beginnen die Überschrifen...
Filiale / Name / Straße / PLZ / Ort / Colli usw.
Nun will ich gerne das wenn ich im z.B Bereich A4:E20 Werte stehen habe, diese per Button in das Blatt "Archiv" ebenfalls ab Zeile 4 verschoben werden und im Blatt "Paletten" entfernt / gelöscht werden.
Wenn ich nun wieder neue Werte in das Blatt "Paletten" eintrage, sollen diese dann ebenfalls per Klick auf den Button wieder ins Archiv geschoben werden, aber direkt unter den letzten Satz / Zeile des Archivs. Also immer angehangen werden.
Leider bin ich bei Google auf dieverse Lösungen gestoßen die nicht das gemacht haben was sie sollten.
Ich hoffe hier kann mir einer helfen.
mfg

Moin
Sind Fragen offen.
Koennen leere Zeilen im Bereich sein?
In welcher Spalte(Paletten) kann man den letzten Eintrag herleiten?
gruss hary

Hi Hary,
NEiN leere Zeilen sollten dort nicht vorkommen, ich denke es macht aber Sinn dieses mit einzubauen, weil andere damit Arbeiten werden und dann weiß man ja nie.
Leere Zellen werden vorkommen.
Was meinst du herleiten?
Welche die letzte Spalte ist, in der ein Wert steht?
Oh, dass weiß ich jetzt gar nicht so genau.
Das kann man doch aber noch anpassen, oder?

Moin
Um etwas anzuhaengen braucht es eine Spalte wo in den Zellen immer etwas steht. Dann kann man sagen Bsp.: in SpalteA steht immer etwas und da nimm die letzte belegte Zelle + 1 und haenge dran.
Mit UsedRange geht es auch, kann aber in die Hose gehen.
Lad mal eine bsp.-Mappe hoch.
gruss hary

Hallo Hary,
nen bisschen hab ich und ein Freund (Java Entwickler) hinbekommen.
Wir haben es schon mal soweit hinbekommen, dass nur die Werte übertragen werden.
Jedoch haben wir noch das Problem, das wenn wir am Schluss die Zeilen löschen, die SVERWEISE logischer Weise ebenfalls weg sind. Die SVERWEISE in den Spalten B:E sollten vorhanden bleiben oder wieder eingefügt werden.
Auch sollte die Dropdown Box in Spalte G nicht mitkopiert und gelöscht werden.

https://www.herber.de/bbs/user/97823.xlsm

Moin
Probier mal so.

Dim letzte As Long
Dim a As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
For a = 4 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountBlank(wksQ.Cells(a, 1).Resize(1, 7)) < 7 Then
letzte = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksQ.Cells(a, 1).Resize(1, 7)
wksZ.Cells(letzte, 1).Resize(1, 7).Value = .Value '---nur Werte uebertragen
.ClearContents
End With
End If
Next
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")

gruss hary

Hallo Hary,
soweit so gut.
Jedoch sind leider die SVERWEISE ab der Zeile in der man Werte, im Blatt "Paletten" ebenfalls weg.
Diese sollen schon drin bleiben, ohne das man diese immer wieder reinkopieren muss.
Das gleiche sollte dann auch für das Dropdown gelten.

Moin
Dann so.

Dim letzte As Long
Dim a As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
For a = 4 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountBlank(wksQ.Cells(a, 1).Resize(1, 7)) < 7 Then
letzte = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksQ.Cells(a, 1)
wksZ.Cells(letzte, 1).Resize(1, 7).Value = .Resize(1, 7).Value
.ClearContents 'nur SpalteA loeschen
.Offset(0, 6) = "" 'SpalteG leeren
End With
End If
Next
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")

gruss hary

Hallo Hary,
hat geklappt, danke.
Ich habe aber das vorherige genommen und einfach die Formeln wieder mit reinkopiert, falls einer diese löscht.
Vielen Dank für die super Hilfe.

Sub Archiv()
Dim letzte As Long
Dim a As Long
Dim wksQ As Worksheet
Dim wksZ As Worksheet
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
For a = 4 To wksQ.Cells(Rows.Count, 1).End(xlUp).Row
If Application.CountBlank(wksQ.Cells(a, 1).Resize(1, 9)) < 9 Then
letzte = wksZ.Cells(Rows.Count, 1).End(xlUp).Row + 1
With wksQ.Cells(a, 1).Resize(1, 9)
wksZ.Cells(letzte, 1).Resize(1, 9).Value = .Value '---nur Werte uebertragen
.ClearContents
End With
End If
Next
Set wksQ = Worksheets("Paletten")
Set wksZ = Worksheets("Archiv")
With wksQ
.Range("B4:B100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;2;FALSCH);"" _
"")"
.Range("C4:C100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;3;FALSCH);"" _
"")"
.Range("D4:D100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;4;FALSCH);"" _
"")"
.Range("E4:E100").FormulaLocal = "=WENNFEHLER(SVERWEIS($A4;Adressen!$A$2:$E$500;5;FALSCH);"" _
"")"
.Range("I4:I100").FormulaLocal = "=WENN($H4="""";"""";ARBEITSTAG($H4;1;WENNFEHLER(SVERWEIS( _
ARBEITSTAG(Paletten!$H4;1)&SVERWEIS(Paletten!$E4;Postleitzahlen!$B:$F;5;FALSCH);Feiertage!$A:$B;2;FALSCH);0)))"
End With
End Sub