Bereich in andere Tabelle kopieren

Question

Hallo Ihr netten Supporter,

meine Anfrage ist hier wohl schon öfters in ähnlicher oder abgewandelter Form gestellt worden und ich habe bereits versucht, mir aus den jeweiligen Antworten ein passendes Makro zu basteln, aber ich bekomme das leider nicht hin.

Ich möchte aus Tabelle A einen Bereich in Tabelle B kopieren.

Der Bereich soll in der Tabelle A von Zelle A3 bis zur letzten in Zeile 3 gefüllten Spalte sowie bis zur letzten in Spalte E gefüllten Zeile reichen.

Eingefügt werden sollen die Inhalte dieses Bereichs in Tabelle B ab Zelle A21.

Reichts das so als Beschreibung, oder bedarf es einer Beispielmappe?

Besten Dank im Voraus!

insomnic

Answer 1

Hallo Rainer,

wenn sich jemand zu entschuldigen hat, dann allenfalls ich, weil ich meine Anfrage nicht von vornherein auf den Punkt gebracht habe, und nicht Du, weil Du mal vorübergehend nicht online warst... zumal Deine Antworten immer noch in rekordverdächtigem Tempo kommen. Man könnte fast denken, dass Du hier ständig nur auf Anfragen lauerst ;-)

Dein Makro in Antwort 9 scheint, soweit ich es nach kurzem Testen beurteilen kann, nunmehr bestens zu funktionieren.

Aus meiner laienhaften Sicht kann ich nicht beurteilen, inwieweit das Makro in Antwort 10 tatsächlich eine wesentliche programmtechnische Vereinfachung darstellt (der Code unterscheidet sich ja von der Vorgängerversion augenscheinlich nur in der Syntax des Copy Befehls), hat allerdings den Nachteil, dass das Programm mit der Aktivierung der Zelle A1 in Tabelle A endet und nicht in der Tabelle, aus der heraus das Makro gestartet wurde.

Allerdings schaue ich mir die Codes immer sehr interessiert an, obwohl ich von VBA mangels jeder Vorkenntnisse wirklich keinen Plan habe, und bin darauf gekommen, dass man diesen Nachteil wohl dadurch ausbügeln kann, dass man vor der abschließenden Selektion von "A1" noch eine Zeile

strStartBlatt = ActiveSheet.Name

einfügt. Sehe ich das richtig, oder gibt es da noch irgendeinen Haken, den ich übersehen habe (kurzes Feedback wäre nett)?

So oder so (Antwort 9 oder modifizierte Antwort 10) dürfte mein Problem gelöst sein, aber ich werde das in den nächsten Tagen noch genauer austesten. Auf jeden Fall an dieser Stelle schon meinen herzlichsten Dank, natürlich auch an fedjo!

Stefan

Answer 2

Moin,

Wenn hier schon alle den Code vom Vorposter anpassen/aendern,
dann moecht ich auch mitspielen. ;-)

Da mir die Tabellenwechsel ( Sheets("Tabelle A").Select) unnoetig erscheinen,
habe ich Rainer's (rainberg) Code nun wiederum auf meine Weise angepasst.
Sieht dann bei mir aus wie folgt:

Sub copy_paste()
With Sheets("Tabelle A")
.Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, _
.Cells(3, .Columns.Count).End(xlToLeft).Column)).Copy
End With
With ActiveSheet.Range("A21")
.PasteSpecial Paste:=xlAll
.Select
End With
Application.CutCopyMode = False
End Sub

Cu
TheBlackBird ®
... der nun mit rainberg gemeinsam auf nighty's Manoever-Kritik warten wird ;-) ;-D

Answer 3

Moin,

Nachtrag:
Ich habe noch eine Kleinigkeit eingefuegt, damit man sich die QuellTabelle nicht
durch einen versehentlich Makrostart "verhunzen" kann.

Sub copy_paste()
With Sheets("Tabelle A")
If .Name = ActiveSheet.Name Then Exit Sub
.Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, _
.Cells(3, .Columns.Count).End(xlToLeft).Column)).Copy
End With
With ActiveSheet.Range("A21")
.PasteSpecial Paste:=xlAll
.Select
End With
Application.CutCopyMode = False
End Sub

Cu
TheBlackBird ®

Answer 4

@ TheBlackBird

man sieht eben, wer ein Fachmann ist::-)

Ich hatte mich zwar auch schon mal auf die With-Schiene begeben und versucht ohne Quell- u. Zielblatt zu selektieren auszukommen, aber da war irgendwo noch ein Fehler.
Naja, Du hat es ja nun professionell gerichtet und ich habe dazu gelernt.

... der nun mit rainberg gemeinsam auf nighty's Manoever-Kritik warten wird ;-) ;-D

...da mach' ich mir aber nicht viel Hoffnung.

@ Stefan

Du hast das schon richtig erkannt, aber nimm den Code von @ TheBlackBird, der ist eleganter und dürfte auch für Dich leichter zu verstehen sein.

Gruß
Rainer

Answer 5

Hallo TheBlackBird,

na so ein Zufall Dich auch hier zu sehen, willst Dir wohl Deine Tantiemen sichern ;-)

Fast schon überflüssig zu erwähnen, dass Deine Version nach meinen ersten Eindrücken ebenfalls tiptop funktioniert, und wenn mir diese aus Rainers berufenem Mund ans Herz gelegt wird, werde ich dann natürlich die nehmen. Die Idee mit dem Überschreibschutz finde ich auch ganz pfiffig.
Ist für mich als Laien auch interessant, wie sich Lösungen mit unterschiedlichen programmtechnischen Ansätzen umsetzen lassen.

Auf jeden Fall ist es der reine Wahnsinn, wie schnell und effektiv einem hier geholfen wird, und dann auch noch mit vereinten Kräften! Jetzt stehe ich allerdings vor dem Dilemma, wem ich hier den 50-Bonuspunkte-Lorbeer aufsetzen soll...

Meine ursprüngliche Fragestellung wurde zuerst von Rainer funktional verwertbar in Antwort 3 gelöst.
Für die ergänzte Aufgabenstellung mit der aktiven Tabelle hat dann fedjo den Code in Antwort 7 angepasst.
Den nachträglich entdeckten Schönheitsfehler mit dem Überschreiben des rechten Bereichs hat dann Rainer mit seinen Antworten 9 bzw. 10 ausgemerzt, so dass spätestens ab hier auch die erweiterte Aufgabenstellung voll und zukunftssicher gelöst gewesen sein dürfte.
Und jetzt kommt noch TheBlackBird und verdient sich einen Schönheitspreis mit Krönchen...

Also an dieser Stelle nochmals meinen herzlichsten Dank an alle Beteiligten! Aber was mache ich denn jetzt mit den Punkten???

Rein logisch und auf diesen Beitrag begrenzt würde ich die der schnellsten vollständigen Lösung, also Rainer, zusprechen, allerdings hast Du, TheBlackBird, mir in meinem anderen Beitrag auch schon gaaaaaanz besonders fleißig und zudem als einziger geholfen. Und in diesem anderen Beitrag konnte ich leider keine Punkte vergeben, weil ich bei Aufgabenstellung noch nicht registriert war und die Funktion auch nach meiner nachträglichen Registrierung augenscheinlich leider nicht aufrufbar ist.

Wie handhabt man das hier, ohne die Mühen und Verdienste eines einzelnen zu schmälern? Meinungen?

Stefan

Answer 6

Moin,

@ insomnic
Bei DIESEM Problem mit den Punkten kann ich Dir leider nicht helfen.
Dennoch moechte ich Dir mit folgendem Kommentar die Entscheidung erleichtern.

Ich fuer meinen Fall interessiere mich hier in keinster Weise fuer irgendwelche Punkte.
Ob es welche gibt, oder nicht ist mir voellig egal. Eine Rueckmeldung im Thread, auch
wenn diese nur aus "Funktioniert wie gewuenscht." besteht, ist fuer mich wichtiger und
Dank genug. Wenns selbst das nicht gibt, kann ich aber durchaus auch damit weiterleben. ;-)

Cu
TheBlackBird ®

Answer 7

Hallo Stefan,

zwecks der Bewertung, schließe ich mich @TheBlackBird voll inhaltlich an.

Gruß
Rainer

Answer 8

Nach nun gut 2-wöchiger Anwendung bin ich mit den hier entwickelten Ergebnissen immer noch sehr zufrieden und möchte mich bei allen Beteilgten nochmals herzlich bedanken, habe jedoch noch eine weitere Anschlussfrage.

Grundsätzlich hat es sich bewährt, das Makro aus dem aktiven Tabellenblatt heraus aufzurufen, allerdings wäre es manchmal auch sinnvoller und zeitsparender, wenn sich die im Eingangsbeitrag beschriebenen Kopieraktionen mit nur einem Programmaufruf hintereinander in allen in der Mappe enthaltenen Blättern (mit Ausnahme der Tabelle A, welche ja die Ursprungstabelle darstellt) ausführen ließen.

Deshalb hiermit meine weitere Anschlussfrage, ob und wie sich das entsprechende Abarbeiten aller Tabellenblätter in einem weiteren Makro bewerkstelligen lässt?

Dieses soll das bereits entwickelte Makro nicht ersetzen, sondern lediglich eine Alternative darstellen, welche ich dann aus der Tabelle A heraus aufrufen möchte, sofern das gleichzeitige Kopieren des Tabellenbereichs für alle anderen Blätter erwünscht ist.

Würde mich freuen, wenn ich wieder so tatkräftige Unterstützung erfahre, und bedanke mich schon im Voraus recht herzlich!

Stefan

Answer 9

Moin,

Die gewuenschte Anpassung wuerde bei mir nun aussehen wie folgt:

Sub copy_paste()
Dim wksTarget As Worksheet
ReDim strArray(1 To ThisWorkbook.Worksheets.Count - 1) As String
Dim lngCount As Long

Const strSourceWks As String = "Tabelle A" 'ggf. ANPASSEN
Const strTRange As String = "A21" 'ggf. ANPASSEN

If ActiveSheet.Type <> xlWorksheet Then End

With Sheets(strSourceWks)
.Range(.Cells(3, 1), .Cells(.Cells(.Rows.Count, 5).End(xlUp).Row, _
.Cells(3, .Columns.Count).End(xlToLeft).Column)).Copy
End With
If ActiveSheet.Name = strSourceWks Then
For Each wksTarget In ThisWorkbook.Worksheets
If wksTarget.Name <> strSourceWks Then
lngCount = lngCount + 1
strArray(lngCount) = wksTarget.Name
End If
Next wksTarget
Application.ScreenUpdating = False
With Sheets(strArray)
.Select
With Range(strTRange)
.PasteSpecial Paste:=xlAll
.Select
End With
End With
ThisWorkbook.Worksheets(strSourceWks).Select
Application.ScreenUpdating = True
Else
With ActiveSheet.Range(strTRange)
.PasteSpecial Paste:=xlAll
.Select
End With
End If
Application.CutCopyMode = False
End Sub

Ersetze also das derzeit verwendete Copy_Paste-Makro mit dieser Version. Weise ihm die bevorzugte Tastenkombi zu.
Diese Version "schaut" nun nach der Tabelle, die beim Makrostart aktiv ist. Ist es "Tabelle A" wird die gesuchte Range auf ALLE anderen Worksheets der Mappe kopiert. Ist es nicht "Tabelle A" sollte es sich verhalten, wie in der "alten Version" und die gesuchte Range NUR auf das gerade aktive Worksheet kopieren.

Cu
TheBlackBird ®

Answer 10

Tut genau das, was in der Anschlussfrage gewünscht wurde.

Nochmals vielen Dank für die prompte und überaus kompetente Umsetzung!

Stefan