bei excel per makro einen teil einer großen tabelle in eine neue kopieren

...komplette Frage anzeigen

5 Antworten

folgendes µ kopiert Dir die Markierung (einzeilig!) und fügt sie auf dem Zielblatt in die bestehende Markierung ein, versetzt die Markierung ein nach unten und aktiviert Dir dann wieder das Quellblatt fürs nächste mal, beliebig oft:
De Blattnamen musst Du natürlich anpassen.

Sub KopierenAuswahlEinfügenInAnderemBlattEinsUnterVorigem()

Sheets("Quellblatt").Activate

Selection.Copy

Sheets("Zielblatt").Activate

ActiveSheet.Paste

Selection.Offset(1, 0).Select

Sheets("Quellblatt").Activate

End Sub

Du musst nur sicherstellen, dass AM ANFANG BEIDE Auswahlen stimmen. Kann ganze Zeile sein oder eine einzeilige Markierung (für zweizeilige Bereiche muss es heissen offset(2, 0))

im Zielblatt genügt die Markierung der ersten Zelle des Einfügeorts.

Wenn Du im Quellblatt einen Titel fixierst (am besten Zeilen UND Spalten und einen Knopf links oben da drin platzierst, kannst Du dem das Makro zuweisen und hast den Knopf immer sichtbar, egal wo im Blatt Du arbeitest!

Es ist zwar nicht die feine Art, mit ständig .Activate zu arbeiten, aber anders wäre es mir im Moment zu umständlich. Es geht jedenfalls so.

Iamiam 21.03.2012, 21:29

ich hab noch einen Schutz gegen doppeltes Einfügen in Folge dazugebaut.
Füge folgendes nach Activesheet.paste in eine neue Zeile ein:

  Dim Antw  

  If Selection.Cells(1) = Selection.Cells(1).Offset(-1, 0) And Selection.Cells(1).Offset(0, 1) = Selection.Cells(1).Offset(-1, 1) And Selection.Cells(1).Offset(0, 2) = Selection.Cells(1).Offset(-1, 2) Then  

        Antw = MsgBox("die ersten 3 Zellen stimmen überein: im Zielblatt löschen und weiter?", vbYesNo, "Doppeleintrag?")

If Antw = 6 Then Selection.Clear: Sheets("T2").Activate: Exit Sub

  End If  

Die Zeile If Antw =... ist ein if ..then ohne Else (einzeilige if..then-Variante, bei der die weiteren Aktionen in der gleichen Zeile stehen), sie besteht aus mehreren durch Doppelpunkt aneinandergehängten Befehlen (eine Möglichkeit, die Du vielleicht noch nicht kennst)

Warum hier wieder mal ein Teil als Code und ein anderer Teil das Codes als Text dargestellt wird, kann ich nicht nachvollziehen

0
Iamiam 24.03.2012, 01:30
@Iamiam

ich hab ein neues Makro geschrieben, das Deine Anforderungen erfüllen sollte. (sofern die Zeit 4 Spalten links vom grünen Bereich ist, wie in Deinem Screenshot)

  1. Trage im Makro manuell den Zielblattnamen ein.

  2. Kennzeichne erst die Einfügestelle im Zielblatt (zB B3, keinesfalls Spalte A).

  3. Markiere dann im Quellblatt die ganzen Spalten (G:S) am Spaltenkopf.

  4. Makro starten

  5. Rückfrage bestätigen oder abbrechen

  6. gewünschte Zeilen am Zeilenkopf markieren
    (mit gedrückt gehaltener Strg-Taste kannst Du auch gestückelte Zeilenfolgen problemlos auswählen und verarbeiten, also zB 5:5, 8:11, 14, 17... die Frequenzzeile markierst Du auch)

  7. Auswahl bestätigen: Makro läuft ab.

...Hier das Makro:

Sub KreuzungsbereichÜbertragen()

Dim Antw, QBNam, R, SpA, SpE, ZBer, ZBNam, Zeit

ZBNam = "T2" ' <= ZielBlattName muss händisch eingetragen werden, QuellBlattName geht automatisch

QBNam = ActiveSheet.Name

If Selection.Rows.Count >= 65536 Then SpA = Selection.Column: SpE = Selection.Column + Selection.Columns.Count - 1

Antw = MsgBox("ist im Zielblatt der gewünschte 1.Einfügeort markiert?", vbOKCancel): If Antw = vbCancel Then Exit Sub

Set ZBer = Application.InputBox("wählen Sie die gewünschten Zeilen aus", "Spalten " & Chr(SpA + 64) & ":" & Chr(SpE + 64), vbOKCancel, , , , , 8)

'If ZBer = vbCancel Then Exit Sub 'wie bindet man vbcancel ein? mit ok geht es

For Each R In ZBer.Rows

Zeit = ActiveSheet.Cells(R.Row, SpA).Offset(0, -4).Value '<=kopiert Inhalt gelbe Zelle (falls 4. links davon) in die Variable

ActiveSheet.Range(Cells(R.Row, SpA), Cells(R.Row, SpE)).Interior.Pattern = xlLightUp '<=nur zur opt. Kennzeichnung, dass rüberkopiert

ActiveSheet.Range(Cells(R.Row, SpA), Cells(R.Row, SpE)).Interior.PatternColor = 16751103 '<=nur zur opt. Kennzeichnung, dass rüberkopiert

ActiveSheet.Range(Cells(R.Row, SpA), Cells(R.Row, SpE)).Copy

ActiveWorkbook.Sheets(ZBNam).Activate

ActiveSheet.Paste

ActiveCell.Offset(0, -1).NumberFormatLocal = "hh:mm:ss" 'trägt links daneben Zeit ein

ActiveCell.Offset(0, -1).Value = Zeit 'trägt links daneben Zeit ein

ActiveCell.Offset(0, -1).Interior.ColorIndex = 6 'färbt diese Zelle gelb

ActiveCell.Offset(1, 0).Select 'versetzt Markierung in zB Spalte B eins runter für nächsten Eintrag

Sheets(QBNam).Activate

Next

End Sub

Beim Abbrechen auf Stufe der InputBox gibts einen Fehler, ich habs erst mal nicht mehr hingekriegt, wie man vbCancel in eine Abfrage einbaut, die eine Objektvariable zurückgibt. Sollte aber gar nicht auftreten.

0
Iamiam 24.03.2012, 15:59
@Iamiam

den Fehler kann man vermeiden mit folgenden Befehlen:
vor inputbox:
on error goto falscheAuswahl
nach inputbox Fehlerbehandlung zurückstellen mit:
on error goto 0
und nach Next einfügen:
falscheAuswahl:
End Sub
wichtig: der Doppelpunkt nach falscheAuswahl kennzeichnet eine Sprungmarke, muss also unbedingt sein, nicht aber im Befehl goto.

Mir ist noch die Idee gekommen, dass ich Dich falsch verstanden haben könnte: dass Du nämlich die gelbe Hintergrundfarbe als Erkennungsmarkierung verwenden möchtest? Werde mich heut nacht nochmal dransetzen, oder, wenn ich zu müde bin, morgen nacht!

0
Iamiam 02.04.2012, 11:56
@Iamiam

danke für K+* !
die Frequenzliste mit erfassen:
einfach bei gedrückter Strg-Taste ganze Zeile ebenfalls markieren, das µ "versteht" Kombinationen von Zeilen (und, glaube ich, auch von Spalten. ist schon wieder etwas her). wenn nicht, melde Dich nochmal!

0
Iamiam 02.04.2012, 19:14
@Iamiam

ist die Zeit immer in Sp.C ? dann:
Zeit = ActiveSheet.Cells(R.Row, SpA).entirerow.cells(3).value

und nach Paste kommt dann:

ActiveCell.entirerow.cells(1).NumberFormatLocal = "hh:mm:ss"
ActiveCell.entirerow.cells(1).Value = Zeit 'trägt links daneben Zeit ein ActiveCell.entirerow.cells(1).Interior.ColorIndex = 6 'färbt diese Zelle gelb

'das trägt Zeit in Sp.A ein und formatiert die Zelle entsprechend

0

nein nein das hilft mir leider alles nicht, ich möchte ja wie gesagt nicht die markierten bereiche kopieren sondern die dazwischen vllt hilft mir das bild zur erläuterung: ich möchte die gelben bereiche auswählen und dadurch den grünen bereich kopiert bekommen. die frage ist auch ob das überhaupt möglich ist :(

help - (Excel, Visual Basic, makro)
Iamiam 22.03.2012, 23:05

das ging leider aus Deiner Frage nicht hervor!
Prinzipiell sollte das gehen, sofern:
die Auswahl sich immer auf Zeile 1 bzw auf Spalte A bezieht und
die Auswahl in Spalte A klein ist und
die Auswahl in Spalte A gleichzeitig getroffen wird, oder aber im Verlauf des Makros auf eine entsprechende Zwischenabfrage.
Willst Du am Anfang zB C1:D1 und A4:A6 plus ggf A10, A13, A27 gemeinsam markieren? Und C4:D4, dann C5:D5, dann ... ins Zielblatt bringen? Oder sind da Formelbezüge, die dadurch gestört werden könnten? Wieviele Zeilen werden es voraussichtlich? Sind da überhaupt unregelmässig abwechselnde Zeilen zu kopieren, oder ist es so "einfach" wie auf Deinem Screenshot?

Bevor ich mich da nochmals reinvertiefe, möchte ich schon genau wissen, ob es so läuft, wie ich mir das vorstelle: also im Zielblatt dann irgendwo die Kopie von C4:D4, darunter die Kopie von C5:D5, darunter die Kopie von C6:D5 und darunter dann ggf weitere?

0
Lanalove 23.03.2012, 12:20
@Iamiam

> "Prinzipiell sollte das gehen, sofern: die Auswahl sich immer auf Zeile 1 bzw auf Spalte A bezieht und die Auswahl in Spalte A klein ist "

leider nicht es bezieht sich immer auf zeile 9 und spalte C :( die auswahl sollte eigentlich auch nicht in der größe begrenzt sein das wär nicht gut

ansonsten ist es so "einfach wie auf dem screenshot, makro starten, zeilen markieren, spalten markieren fertig :) am besten, ich poste mal wie die tabelle tabelle tatsächlich aussieht

0
Iamiam 28.03.2012, 14:33
@Lanalove

hast Du meine letzten beiden Comments zu meiner Frage gelesen?
ich hab des öfteren reingeschaut, ob Du dich dazu äusserst.
Bei der noch geplanten Auswertung nach Farben hat mir VBA auf den "letzten Metern" noch ein Bein gestellt, so dass ich da ein anderes Konzept brauche.
Hatte aber bisher dringenderes zu tun.
Also probiere noch mal das Makro wie im vorletzten Kommentar zu meiner Frage!

0

Ich denke, so sollte es funktionieren (wenn ich einen Fehler gemacht habe, bitte weist mich darauf hin)

Sub KopiereBereich()

Dim Quelltab As Worksheet

Dim Zieltab As Worksheet

Dim Zelle As Range

Dim Zaehler As Long

Zaehler = 1

Bereich = "A1:A10"

Set Quelltab = ActiveWorkbook.Worksheets("Tabelle1")

Set Zieltab = ActiveWorkbook.Worksheets("Tabelle2")

For Each Zelle In Quelltab.Range("A1:A10")

Zieltab.Cells(Zaehler, 1) = Zelle

Zaehler = Zaehler + 1

Next Zelle

End Sub

Statt A1:A10 musst du bei "Bereich" und bei "For Each Zelle In Quelltab.Range" natürlich die entsprechenden Angaben für deine Tabelle machen.

Wie gesagt, sollte ich einen Fehler gemacht haben, bitte lasst es mich wissen. Danke.

Lanalove 21.03.2012, 17:09

danke fur die schnelle antwort aber ich weiß nicht ob das so ganz ist was ich will.. ich möchte halt zB A10:A20 und G1:X1 markieren und so den bereich G10:X20 in meine neue tabelle bekommen um weiterzurechenen. vllt verstehst du mich so besser :D

0
Mirasci 21.03.2012, 17:42
@Lanalove

Oh je, sowas habe ich selbst noch nicht gemacht.

Da muss ich ein bisschen austesten und probieren. Kann also ne Weile dauern, sorry.

0
Iamiam 21.03.2012, 20:42

Für den Fall A1:A10 ginge das, aber Lanalove hat 40 Spalten: da kämen dann 40 Zellen untereinander! Ausserdem will er/sie mehrere einzeln auszuwählende Zellgruppen rüberkopieren.
Trotzdem: DH

0

Holla die Waldfee! Das ist doch um einiges komplizierter, als ich anfangs dachte. Habe gestern auch noch lange drüber gegrübelt, hat aber nicht den gewünschten Effekt erzielt^^

Das mit dem Schutz kannte ich auch noch nicht. Super Tipp, lamiam! Das gibt nen DH.

wichtig ist mir nur der grüne teil, gelb muss nicht umbedingt mit kopiert werden falls das probleme macht

ursprung - (Excel, Visual Basic, makro) ziel - (Excel, Visual Basic, makro)

Was möchtest Du wissen?