Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: zeilen hochrutschen lassen nach kopieren

zeilen hochrutschen lassen nach kopieren
21.01.2005 14:52:23
Jonny
Also hab mein Problem von gesten ein bißchen in Griff bekommen.
Nun, ich will eine Zeile von einer Tabelle in die nächste kopieren. Dabei sollen die Daten aus der Ursprungstabelle gelöscht werden. Soweit bin ich. Nun sollen aber die daten die unterhalb der zukopierenden Zeile liegen eine Zeile hochrutschen, damit die Zeile nicht leer bleibt.
also mein Quellcode:

Sub button1()
Call Zeile_kopieren(2)
End Sub


Sub button2()
Call Zeile_kopieren(3)
End Sub


Sub Zeile_kopieren(quellzeile As Integer)
Dim zielzeile As Long
zielzeile = Sheets("Erledigte Aufträge").Range("A65536").End(xlUp).Offset(1, 0).Row
Sheets("Aktuelle Projekte 2005").Rows(quellzeile).Copy
Sheets("Erledigte Aufträge").Select
Rows(zielzeile).Select
Selection.PasteSpecial
Application.CutCopyMode = False
Sheets("Aktuelle Projekte 2005").Rows(quellzeile).Clear
Sheets("Aktuelle Projekte 2005").Activate
For i = 1 To 67
If quellzeile < i Then _
Range(i).Select
Selection.Copy
Range((i - 1)).Select
Selection.PasteSpecial
Next i
End Sub

Danke im vorraus...
Anzeige
AW: zeilen hochrutschen lassen nach kopieren
RR
Hallo,
ohne es zu testen, sollte es aber schon gehen, wenn du statt
Clear
Delete Shift:=xlUp
einfügst.
Gruß
RR
AW: zeilen hochrutschen lassen nach kopieren
21.01.2005 15:12:41
Jonny
Das klappt wunderbar.
Danke..
Das einzige Problem ist das es die komplette Zeile löscht und dadurch der gesamte untere Teil nach oben ruscht...
Im Klartext, ich habe einen Bereich von A1: AJ66.
Nun wenn ich das Makro ausführe verringern sich die Zeilen, der bereich wird kleiner (A1:AJ65, A1:AJ64).
Kann ich das nicht irgendwie verhindern.?!
Anzeige
AW: zeilen hochrutschen lassen nach kopieren
RR
Einfach unter
Sheets("Aktuelle Projekte 2005").Rows(quellzeile).Delete Shift:=xlUp
Sheets("Aktuelle Projekte 2005").Rows(66).Insert Shift:=xlDown
einfügen.
Gruß
RR
AW: zeilen hochrutschen lassen nach kopieren
21.01.2005 15:36:50
Jonny
Hi RR,
er ruscht trotzdem hoch.....ausserdem ist es mit dem Rausschneiden insofern schlecht da ich in der letzten spalte jeder Zeile also in bsp. AK2 ein button hab, dem dieses makro zugewiesen ist.
Wenn ich immer die zeilen rausscheiden, schneide ich auch automatisch die Buttons raus.... kann das Problem nicht mit einer For - Schleife und einer if abfrage lösen?!
Die For-schleife müsste dann bsp. 70 mal laufen. die if abfrage müsste überprüfen, ob das i größer ist als die quellzeile? wenn ja dann soll die Zeile i einen nach oben rutschen?!....
Leider kann ich die VBA-Syntax nicht so gut?! Aber so in etwa könnte es glaub ich aussehen?!
Anzeige
AW: zeilen hochrutschen lassen nach kopieren
RR
Kannst du mal ein Beispiel hochladen, damit ich weiß, wie die Datei aussieht. Ferndiagnosen sind immer schwierig.
AW: zeilen hochrutschen lassen nach kopieren
21.01.2005 15:48:17
Jonny
So ...bitte schön....muss natürlich die Daten vorher entfernen....aber so sieht es aus
https://www.herber.de/bbs/user/16562.xls
Anzeige
AW: zeilen hochrutschen lassen nach kopieren
RR
Dann ganz anders:
statt:
Sheets("Aktuelle Projekte 2005").Rows(quellzeile).Delete Shift:=xlUp
Sheets("Aktuelle Projekte 2005").Rows(66).Insert Shift:=xlDown
neu:
Sheets("Aktuelle Projekte 2005").Rows(quellzeile).clear
For s = 1 to 32
For z = 2 to 64
If Sheets("Aktuelle Projekte 2005")cells(z,s).value ="" then
Sheets("Aktuelle Projekte 2005")cells(z,s).value = Sheets("Aktuelle Projekte 2005")cells(z+1,s).value
Sheets("Aktuelle Projekte 2005")cells(z+1,s).value = ""
next z
next s
Hoffe, es klappt!
RR
Anzeige
AW: zeilen hochrutschen lassen nach kopieren
21.01.2005 16:09:57
Jonny
ne klappt wieder nit....hab jeweils hinter der ein Punkt vor "cells" gemacht..hast du glaub ich vergessen...und noch ein end if...aber er meckert trotzdem.."kann nicht im Haltemodus ausgeführt werden"...
AW: zeilen hochrutschen lassen nach kopieren
RR
...sorry, hatte ich wirklich vergessen.
Ich habe jetzt nur mal den Code:
For s = 1 To 32
For z = 2 To 64
If Sheets("Aktuelle Projekte 2005").Cells(z, s).Value = "" And Sheets("Aktuelle Projekte 2005").Cells(z + 1, s).Value "" Then
Sheets("Aktuelle Projekte 2005").Cells(z, s).Value = Sheets("Aktuelle Projekte 2005").Cells(z + 1, s).Value
Sheets("Aktuelle Projekte 2005").Cells(z + 1, s).Value = ""
End If
Next z
Next s
getestet...und es hat damit geklappt.
Muss "leider" jetzt Feierabend machen.
Gruß
RR
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige