Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.07.2024 18:36:17
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
756to760
756to760
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 09:57:05
Daniel
Hallo!
wie dir Überschrift schon sagt, möchte ich aus einem Tabellenblatt ("Bestand") aus den Zeilen, die ich markiere bestimmte Zellinhalte per Knopfdruck in ein anderes Tabellenblatt ("PT neu") kopieren.
Dabei muss einiges beachtet werden, jedoch kann ich selbst dieses Makro nicht erstellen.
Ich hoffe mir kann hier jemande helfen.
Dann beschreibe ich mal kurz was ich machen will:
Ich will von den markierten Zeilen, jeweils die Inhalte der Zellen A,E und G ins Blatt "PT neu" kopieren.
Dabei stehen in "PT neu" allerdings schon Zeilen. Die kopierten Inhalte müssten sich an die letzte gefüllte Zeile des Blatts PT neu anschließen.
Außerdem sind die Spalten nicht gleich: Was in der Ursprungstabelle in A steht kommt nach A, was aber in E steht kommt nach C und was in G steht kommt nach E.
Dann muss ein Datum, das in der Ursprunstabelle in S27 steht jeweils in die neuen Zeilen nach G kopiert werden.
Ich hoffe das ist verständlich und nicht zu viel Wünsche.
Danke für Hilfe,
Daniel

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 13:23:03
Bertram
Hallo Daniel,
meinst du etwa so:
Bevor den Code startest kannst/musst du beliebig viele Zeilen markieren.

Sub ZellenKopieren()
Dim Zelle As Range
Dim ZeileAlt As Integer
Dim ZeileNeu As Integer
Dim Zeile2 As Integer
Zeile2 = Sheets("PT neu").Cells(1, 1).End(xlDown).Row + 1
For Each Zelle In Selection
ZeileNeu = Zelle.Row
If ZeileNeu <> ZeileAlt And ZeileAlt <> 0 Then Zeile2 = Zeile2 + 1
Select Case Zelle.Column
Case Is = 1
Sheets("PT neu").Cells(Zeile2, 1).Value = Zelle.Value
Case Is = 5
Sheets("PT neu").Cells(Zeile2, 3).Value = Zelle.Value
Case Is = 7
Sheets("PT neu").Cells(Zeile2, 5).Value = Zelle.Value
End Select
Sheets("PT neu").Cells(Zeile2, 7).Value = Sheets("Bestand").Range("S27").Value
ZeileAlt = ZeileNeu
Next Zelle
End Sub

Gruß
Bertram
Anzeige
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 13:32:46
Daniel
Hallo!
Da kommt ein Fehler: "Überlauf" und es wird die Zeile
Zeile2 = Sheets("PT neu").Cells(1, 1).End(xlDown).Row + 1
markiert!?
Grüße,
Daniel
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 13:41:33
Bertram
Hallo,
habe der Einfachheit halber integer-Variablen deklariert. Sollten sie größer als 32.767 werden, sprich dur höhere Zeilennummern hast, deklariere sie um in Single oder Variant.
Hoffe das war's, sonst lade mal deine Datei hoch. Bei mir funktionierts soweit.
Gruß
Bertram
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 13:59:02
Daniel
Hallo Bertram,
ich habe mal eine ganz neue Datei genommen.
Es geht nicht! Es gibt auch nur eine Zeile.
https://www.herber.de/bbs/user/33022.xls
Grüße,
Daniel
Anzeige
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 14:15:52
Bertram
Hallo Daniel,
den Fall mit nur einer Zeile hab ich nicht getestet:-(
Ändere
Zeile2 = Sheets("PT neu").Cells(1, 1).End(xlDown).Row + 1
durch
Zeile2 = Sheets("PT neu").Cells(65536, 1).End(xlUp).Row + 1
Dann sollte es gehen.
Gruß
Bertram
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 14:31:44
Daniel
Hallo!
Okay, das funktioniert nun. Vielen Dank. Leider arbeitet der Code sehr langsam.
vielleicht kannst du das etwas schneller machen? Die markierten Zeilen sind immer aneinanderhängen, also 15-58 oder so.
Zusätzlich habe ich noch zwei kleinere Bitten:
In PT neu sollen in den neu hinzugekommenen Zeilen in Zelle B "VK" und in Zelle F "PT" reingeschrieben werden.
In PT neu stehen Ab Zeile 2 Zeilen. Zeile 1 sind Überschriften.
In Spalte G steht immer ein Datum. Wenn dieses Datum älter als das heutige Datum ist, dann müsste die jeweilige Zeile gelöscht werden.
Das muss dem ganzen anderen Prozess noch vorweggeschaltet werden.
Danke für die tolle Hilfe!
Daniel
Anzeige
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 16:19:29
Bertram
Folgendes sollte funktionieren:

Sub ZellenKopieren()
Dim Zelle As Range
Dim ZeileAlt As Integer
Dim ZeileNeu As Integer
Dim Zeile2 As Integer
'Zeilen löschen
With Sheets("PT neu")
.Activate
.Cells(2, 7).Activate
End With
Do
If ActiveCell.Value < Date Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until ActiveCell.Value = ""
Zeile2 = Sheets("PT neu").Cells(65536, 1).End(xlUp).Row + 1
Sheets("Bestand").Activate
For Each Zelle In Selection
ZeileNeu = Zelle.Row
If ZeileNeu <> ZeileAlt And ZeileAlt <> 0 Then Zeile2 = Zeile2 + 1
Select Case Zelle.Column
Case Is = 1
Sheets("PT neu").Cells(Zeile2, 1).Value = Zelle.Value
Case Is = 5
Sheets("PT neu").Cells(Zeile2, 3).Value = Zelle.Value
Case Is = 7
Sheets("PT neu").Cells(Zeile2, 5).Value = Zelle.Value
End Select
With Sheets("PT neu")
.Cells(Zeile2, 7).Value = Sheets("Bestand").Range("S27").Value
.Cells(Zeile2, 2).Value = "VK"
.Cells(Zeile2, 6).Value = "PT"
End With
ZeileAlt = ZeileNeu
Next Zelle
End Sub

Schneller ist die Sache noch nicht, aber ich bastle mal was anderes zusammen.
Gruß
Bertram
Anzeige
AW: Aus markierten Zeilen bestimmte Zellen kopieren
21.04.2006 16:33:56
Bertram
So gehts schneller, da weniger Zelle bearbeitet werden. Geht jetzt allerdings nur mit zusammenhängenden Bereichen.

Sub ZellenKopierenNeu()
Dim Zelle As Range
Dim ZeileAlt As Integer
Dim ZeileNeu As Integer
Dim Zeile2 As Integer
Dim ZeileAnfang As Integer
Dim ZeileEnde As Integer
Application.ScreenUpdating = True
'Zeilen löschen
With Sheets("PT neu")
.Activate
.Cells(2, 7).Activate
End With
Do
If ActiveCell.Value < Date Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until ActiveCell.Value = ""
ZeileAnfang = InputBox("Zeile Anfang:")
ZeileEnde = InputBox("Zeile Ende:")
Zeile2 = Sheets("PT neu").Cells(65536, 1).End(xlUp).Row + 1
Sheets("Bestand").Activate
For Each Zelle In Range(Cells(ZeileAnfang, 1), Cells(ZeileEnde, 7)).Cells
ZeileNeu = Zelle.Row
If ZeileNeu <> ZeileAlt And ZeileAlt <> 0 Then Zeile2 = Zeile2 + 1
Select Case Zelle.Column
Case Is = 1
Sheets("PT neu").Cells(Zeile2, 1).Value = Zelle.Value
Case Is = 5
Sheets("PT neu").Cells(Zeile2, 3).Value = Zelle.Value
Case Is = 7
Sheets("PT neu").Cells(Zeile2, 5).Value = Zelle.Value
End Select
With Sheets("PT neu")
.Cells(Zeile2, 7).Value = Sheets("Bestand").Range("S27").Value
.Cells(Zeile2, 2).Value = "VK"
.Cells(Zeile2, 6).Value = "PT"
End With
ZeileAlt = ZeileNeu
Next Zelle
Sheets("PT neu").Activate
Application.ScreenUpdating = False
End Sub

Gruß
Bertram
Anzeige
AW: Aus markierten Zeilen bestimmte Zellen kopieren
24.04.2006 08:41:25
Daniel
Hallo Bertram,
danke. Das sieht schon sehr gut aus. Kann man das aber anders lösen als mit den Eingabeboxen? Das das wirklich über Markierungen läuft?
Grüße,
Daniel
AW: Aus markierten Zeilen bestimmte Zellen kopieren
24.04.2006 12:47:43
Bertram
Hi Daniel,
geht auch.

Sub ZellenKopierenNeu()
Dim Zelle As Range
Dim ZeileAlt As Integer
Dim ZeileNeu As Integer
Dim Zeile2 As Integer
Dim ZeileAnfang As Integer
Dim ZeileEnde As Integer
Application.ScreenUpdating = True
'Zeilen löschen
With Sheets("PT neu")
.Activate
.Cells(2, 7).Activate
End With
Do
If ActiveCell.Value < Date Then
ActiveCell.EntireRow.Delete
Else
ActiveCell.Offset(1, 0).Activate
End If
Loop Until ActiveCell.Value = ""
Zeile2 = Sheets("PT neu").Cells(65536, 1).End(xlUp).Row + 1
Sheets("Bestand").Activate
ZeileAnfang = Left(Selection.Address(0, 0), InStr(1, Selection.Address(0, 0), ":") - 1)
ZeileEnde = Mid(Selection.Address(0, 0), InStr(1, Selection.Address(0, 0), ":") + 1)
For Each Zelle In Range(Cells(ZeileAnfang, 1), Cells(ZeileEnde, 7)).Cells
ZeileNeu = Zelle.Row
If ZeileNeu <> ZeileAlt And ZeileAlt <> 0 Then Zeile2 = Zeile2 + 1
Select Case Zelle.Column
Case Is = 1
Sheets("PT neu").Cells(Zeile2, 1).Value = Zelle.Value
Case Is = 5
Sheets("PT neu").Cells(Zeile2, 3).Value = Zelle.Value
Case Is = 7
Sheets("PT neu").Cells(Zeile2, 5).Value = Zelle.Value
End Select
With Sheets("PT neu")
.Cells(Zeile2, 7).Value = Sheets("Bestand").Range("S27").Value
.Cells(Zeile2, 2).Value = "VK"
.Cells(Zeile2, 6).Value = "PT"
End With
ZeileAlt = ZeileNeu
Next Zelle
Sheets("PT neu").Activate
Application.ScreenUpdating = False
End Sub

Gruß
Bertram
Anzeige
Danke! So ist es sehr gut! o.T.
24.04.2006 12:52:21
Daniel
...
Gerne. Noch andere Fragen...
24.04.2006 12:55:11
Bertram
... oder wieso hast du die Frage noch als 'offen' markiert?
Gruß
Bertram
Sorry, war versehentlich. o.T.
24.04.2006 13:18:58
Daniel
..

319 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige