Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
756to760
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum
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
..

300 Forumthreads zu ähnlichen Themen


Hallo,
ich suche eine sicherlich einfache Möglichkeit Summen in einer bestimmten Zeile bilden zu lassen. Das Problem ist das die Bereiche unterschiedlich groß sind.
Zur besseren Erläuterung habe ich eine Bsp-Datei angehängt.
Vielen Dank!
MfG Tom
Die Datei https://www.herber....
Anzeige

Hallo Zusammen
Ich möchte gern nur die Werte in sichtbaren Zellen addieren. Mit der Nettosummenformel geht das aber nicht, weil bei meiner Problemstellung es kein zusammenhängender Bereich ist, sondern die Werte in Zellen der Spalten A, C, E, G... stehen.
Kann dieser VBA-Code evtl. an...

Hi,
der folgende Code soll in der Spalte Q das Datum umformatieren. Nun habe ich aber auch in der Spalte Q auch leere Zellen drin und der Code schreibt dann in die leeren Zellen immer 01.01.1900 rein, obwohl sie eigentlich leer bleiben sollen.
Wie kann man den Code ändern, dass leere Ze...
Anzeige

Mahlzeit allerseits,
ich möchte folgendes Addieren.
Beginnend In V6 und dann jede siebte Zelle in Spalte V.
V6+V13+V20 usw. bis zum Ende des Tabellenblattes, es kommt
aber zwischendurch vor, das sich Text bzw. Symbole in den
Zellen dazwischen befinden.
Wie kann ich am be...

Hallo,
Kann mir jemand bei folgendem Problem helfen:
Ich habe drei Spalten A, B, C.
In Spalte A steht in wenigen Zellen etwas drin und sehr viele Zellen sind leer. In Spalte B wird die Anzahl leerer Zellen der Spalte A gezählt und jedes Mal wenn in A etwas drin steht, beginnt er mit...

Servus,
ich möchte aus einer Excel Datei aus allen darin enthaltenen Blättern jeweils die Spalte A und E in eine neue Excel Datei auf ein Sheet kopieren.
Oder noch genauer:
ich möchte aus einer Excel Datei aus allen darin enthaltenen Blättern jeweils ein Schlüsselwort (unique) als...
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige