Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 19:29:30
Formel filter
24.04.2024 18:49:56
merge & select
24.04.2024 17:19:09
Formel mit Index-Funktion
24.04.2024 16:19:42
SummeWenn / SummeWenns mit Bedingung wenn kleiner als dann
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1852to1856
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1852to1856
1852to1856
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Zellwerte mit Button in Sheets.Row copy

Zellwerte mit Button in Sheets.Row copy
03.11.2021 15:52:53
B
Hallo
Ich habe folgendes Problem:
Auf diversen Sheets (sind immer die selben kopierten Sheets, einfach mit unterschiedlichen Werten bespielt) möchte ich bestimmte Zellen aus der Spalte X (X4:X12;X23;X49..) per Button einmalig, also ohne Datenbankfunktion resp. Ablesen des Inhalts im Zielort, in mein Hauptblatt ("Sammlung") rüberkopieren. Grundsätzlich wohl keine Hexerei.
Nun möchte ich jedoch, dass die Funktion beim Kopieren zuerst in der Zieltabelle ("Sammlung") mit Range die nächste leere Spalte zum beschreiben findet (zB anhand eines Zellbereichs A7:H7 in der "Sammlung", dies ist meine 'Überschrift' der jeweiligen Spalten und soll normal von links nach rechts beschrieben werden).
Eine weitere Bedingung kommt aber noch; der Zielbereich wo die Daten in der "Sammlung" schlussendlich hinkopiert werden, hängt von einer Bedingung ab (zB Zelle C2 in der Ursprungstabelle) ----
wenn C2 = "AA" dann finde nächste leere Spalte in "Sammlung" in A7:H7 , wenn C2 = "AB" dann finde nächste leere Spalte in "Sammlung" in K7:X7 etc. (Total 4 Schlaufen)
Beispieldatei hier:
https://www.herber.de/bbs/user/148928.xlsx

14
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zellwerte mit Button in Sheets.Row copy
03.11.2021 19:32:19
Yal
Hallo B,

Private Sub CommandButton1_Click()
Select Case Me.Range("C2")
Case "AA": Kopieren Me.Name, "H8", "D8:G24"
Case "AB": Kopieren Me.Name, "L8", "H8:K24"
Case Else: MsgBox "In C2 ist weder AA noch AB vorhanden."
End Select
End Sub
Private Sub Kopieren(Quelle, AnkerZelle, Info)
With Worksheets("Sammlung")
If .Range(AnkerZelle).End(xlToLeft).Column
VG
Y
AW: Zellwerte mit Button in Sheets.Row copy
03.11.2021 23:27:33
B
Hallo Yal
Danke für deine Antwort. Leider gibts eine fehlermeldung beim Kompilieren mit dem Schlüsselwort Me in Zeile 2.
Ich verstehe deinen Code nicht ganz, wo werden Quelle, Ankerzelle und Info definiert?
Und anhand der 'Ankerzelle' soll eine andere Spalte im ZIEL ("Sammlung") abgefragt und dann befüllt werden, in der Quelle werden aber die selben Zahlen rauskopiert, egal welcher Case (AA, AB..) zutrifft. Kann es sein, dass dein Code etwas anderes bewirkt?
PS: Ich kopiere beide Sub's in ein Modul oder? Diese sollen ja auf mehreren Sheets nutzbar sein.
Anzeige
Wohin mit dem Dode...
04.11.2021 00:11:19
{Boris}
Hi,

PS: Ich kopiere beide Sub's in ein Modul oder?
Nein - so wie der Code geschrieben ist, gehört er in das Codemodul des entsprechenden Tabellenblattes. Nur darin beinhaltet Me das Tabellenblatt als Objekt.

Ich verstehe deinen Code nicht ganz, wo werden Quelle, Ankerzelle und Info definiert?
Zum Beispiel im Fall AA:
Case "AA": Kopieren Me.Name, "H8", "D8:G24"
Quelle: Me.Name
Ankerzelle: H8
Info: D8:G24
VG, Boris
AW: Wohin mit dem Dode...
04.11.2021 01:13:45
B
Jetzt läufts! Super, danke euch beiden.
Also ist die Ankerzelle die Grenze, bis wohin max. ein Case reingeschrieben werden kann, und davon gehts dann nach links bis es nicht mehr leer ist?
Weil die IF Schleife mit dem xlToLeft 'kleiner' 4 versteh ich noch nicht ganz.. ich möchte die Anzahl Spalten für AA / AB nun selber noch vergrössern können..also einfach beim Case die Spalten anpassen und diese 4 erhöhen?
Wie kann ich beim Kopieren zusätzlich noch die Zelle C3 (die Überschrift) mit in die Zelle 6 der jeweilig aktuellen Spalte in die Sammlung mitgeben?
Anzeige
AW: Wohin mit dem Dode...
04.11.2021 16:03:15
Yal
Hallo B,
Die VBA-Funktion End(xlToLeft) simuliert die Tastenklombi Strg+Pfeil nach links:
(1)
Wenn Du eine Wert in B1 und F1 und dein Markierung auf E1 legst, bewirkt diese Strg+Pfeil nach Link, dass B1 (die erste befüllte Zelle in dieser Richtung) selektiert wird.
Wenn Du dann Strg+Pfeil nach Rechts drückst, wechselt der Auswahl auf F1.
(2)
Wenn Du diese Verhalten innerhalb eines befüllten Blocks, wechselt den Auswahl zwischen letztbefüllt nach links und letztbefüllt nach rechts.
Die AnkerZelle ist die erste Zelle ausserhalb der Bereich. Nach End(xlToLeft) gibt es auf alle Fälle eine neue ausgewählte -oder in dem Fall des Coding addressierte- Zelle. Wenn Du eine Spalte zu weit nach link (<4 oder <8) dann trifft den Fall (2): alle Spalten sind schon belegt.
Wenn Du den Einfüge-Bereich vergrössert, musst Du nur beachten, ab welchem Punkt diese End(xlToLeft) gestartet werden soll.
Die Grenzspalte für AA(<4) wird sich nicht ändern, aber die für AB (<8) schon.
Die Tastenkombi Strg+Pfeil lässt sich übrigens mit Shift kombinieren, um schnell ein ganzen Block zu markieren.
VG
Yal
Anzeige
AW: Wohin mit dem Dode...
04.11.2021 16:51:17
B
Hallo Yal
Danke für die gute Erklärung. Stehe leider weiterhin noch auf dem Schlauch, was 

If .Range(AnkerZelle).End(xlToLeft).Column
konkret zählt...da ich nun 4 Gruppen habe (wobei Gruppe AA+AB mit jeweils Total 17 Spalten und die anderen beiden Gruppen mit je 8 Spalten) muss ich wohl 3 Schleifen bauen und diese Zahl immer bis ganz links zum 'Start' meiner Tabelle abzählen?
Die Ankerzelle habe ich ausserdem 'ausserhalb' des Bereichs (in Zeile 4) gesetzt, da im Zielbereich wo reinkopiert werden soll, teilweise bereits Formeln drin sind (werden nicht als leer erkannt).
Problem ist noch, dass es mir Formeln und Formatierung mitkopiert. Ich möchte eigentlich nur die nackten Zahlen kopieren, und nur wenn die Zelle in der Sammlung noch komplett leer ist also ohne jegliche Formel drin (Alternativ könnte ich die zu kopierenden Zellen im Code auch von Hand auflisten - also zB Q9 nach "x"9, Q10 nach "x"10, Q23 nach "x"23 etc.)? Kannst du mir da weiterhelfen?
PS: Unten mein soweit angepasster Code. Mit Privat Sub konnte ich das Makro nicht dem Button zuordnen/finden, habe daher Option Explicit und einfaches Sub draus gemacht.

Option Explicit
Sub CommandButton1_Click()
Select Case Me.Range("C2")
Case "AA": Kopieren Me.Name, "V4", "D8:U50"
Case "AB": Kopieren Me.Name, "AN4", "W8:AM50"
Case "BB": Kopieren Me.Name, "AW4", "AO8:AV50"
Case "BO": Kopieren Me.Name, "BF4", "AX8:BE50"
Case Else: MsgBox "In C2 ist keine gültige Gruppe ausgewählt!"
End Select
End Sub
Private Sub Kopieren(Quelle, AnkerZelle, Info)
With Worksheets("Sammlung")
If .Range(AnkerZelle).End(xlToLeft).Column

Anzeige
AW: Wohin mit dem Code...
04.11.2021 19:07:42
Yal
Hallo B,
wir müssen die Komplexität reduzieren: die übergegebene Parameter müssen nachvollziehbar sein. Eine AnkerZelle war vorher noch tragbar solang der Bespiel einfach war. Jetzt müssen wir justieren: wir übergeben einfach die erste Spalte und die Breite des Zielbereiches. der Rest wird ermittelt.
Es ist im Kern nicht anders als vorher, wirkt nur ein Bischen wurtiger. Aber Du hast gezeigt, dass Du den Code auseinander setzen kannst, daher bin ich zuversichtlich, dass Du nach der erste Stufe, diese auch packen wirst :-)
Die Wert die sich nicht ändern, sind als Konstanten abgelagert. Der Name hilft mehr zu verstehen als nur 8 oder 43.

Const Ziel_Zeile_erste = 8
Const Ziel_Zeilen_Anzahl = 43 '50 - 8 + 1
Sub CommandButton1_Click()
Select Case Me.Range("C2")
Case "AA": Kopieren Me.Name, "D", 17 '"D8:U50" 'D bis U sind 18 Spalten (?)
Case "AB": Kopieren Me.Name, "W", 17
Case "BB": Kopieren Me.Name, "AO", 8
Case "BO": Kopieren Me.Name, "AX", 8
Case Else: MsgBox "In C2 ist keine gültige Gruppe ausgewählt!"
End Select
End Sub
Private Sub Kopieren(Quelle, Ziel_Spalte_erste, Ziel_Spalten_Anzahl)
Dim AnkerZelle As Range
Dim Ziel_Zelle_erste As Range 'erste Zelle vom Zielbereich
Dim Paste_Zelle_erste As Range
With Worksheets("Sammlung")
Set Ziel_Zelle_erste = .Range(Ziel_Spalte_erste & Ziel_Zeile_erste)
Set AnkerZelle = Ziel_Zelle_erste.Offset(0, Ziel_Spalten_Anzahl)
Set Paste_Zelle_erste = AnkerZelle.End(xlToLeft).Offset(0, 1)
If Paste_Zelle_erste.Column
VG
Yal
Anzeige
AW: Wohin mit dem Code...
04.11.2021 21:36:12
B
Jetzt ist es für mich einiges komplexer als vorher. :) Und es kommt die Fehlermeldung 400
2 Fragen:
Beim Abzählen der leeren Spalten würde ich lieben in Zeile 4 nach links suchen, nicht Zeile 8 (denn dort sind Formeln drin). Wie kann ich das anpassen mit deinem neuen Code?
Und beim reinkopieren hatte ich inzwischen eine funktionierende Lösung gefunden

Else
Worksheets(Quelle).Range("Q8:Q14").Copy    'Teil1 Werte zu Kopieren
.Range(AnkerZelle).End(xlToLeft).Offset(4, 1).PasteSpecial Paste:=xlValues
Worksheets(Quelle).Range("Q17").Copy        'Teil2 Werte zu Kopieren
.Range(AnkerZelle).End(xlToLeft).Offset(13, 1).PasteSpecial Paste:=xlValues
Worksheets(Quelle).Range("Q21:Q22").Copy   'Teil3 Werte zu Kopieren
...
nicht schön, aber hat funktioniert. So wurden nur die Zellen kopiert, die ich wollte. Und alle anderen (wo Formeln drin sind im Ziel) wurden nicht überschrieben.
Jetzt geht das ja nicht mehr, da ich keinen Offset mehr verwenden kann oder?

Private Sub Kopieren(Quelle, Ziel_Spalte_erste, Ziel_Spalten_Anzahl)
Dim AnkerZelle As Range
Dim Ziel_Zelle_erste As Range 'erste Zelle vom Zielbereich
Dim Paste_Zelle_erste As Range
With Worksheets("Sammlung")
Set Ziel_Zelle_erste = .Range(Ziel_Spalte_erste & Ziel_Zeile_erste)
Set AnkerZelle = Ziel_Zelle_erste.Offset(0, Ziel_Spalten_Anzahl)
Set Paste_Zelle_erste = AnkerZelle.End(xlToLeft).Offset(0, 1)
If Paste_Zelle_erste.Column

Anzeige
AW: Wohin mit dem Code...
04.11.2021 22:06:54
B
Hallo Yal
Ich konnte es inzwischen lösen, mit Offset ab Zelle 8:

Else
Worksheets(Quelle).Range("Q8:Q14").Copy ' Teil1
Paste_Zelle_erste.PasteSpecial Paste:=xlValues
Worksheets(Quelle).Range("Q17").Copy 'Teil2
Paste_Zelle_erste.Offset(9, 0).PasteSpecial Paste:=xlValues
Worksheets(Quelle).Range("Q21:Q22").Copy 'Teil3
Paste_Zelle_erste.Offset(13, 0).PasteSpecial Paste:=xlValues
Gebastel, aber es funktioniert so endlich mal. Danke dir!
Was ich noch gesehen habe: es schreibt mir bis Spalte V voll, dann gehts wieder an den Anfang und überschreibt die alten Werte in Spalte H. Die Fehlermeldung kommt gar nie..ist etwas unglücklich.
Ausserdem habe ich zwischen den 4 Gruppen jeweils eine Spalte leer (aus Gründen :) ), wie kann ich dies angehen damit diese Spalten (V / AN / AW) immer leer bleiben?
Anzeige
AW: Wohin mit dem Code...
05.11.2021 09:45:42
Yal
Hallo B,
in dem Du die AnkerZelle für den END(xlToLeft) anders definierst:
Szenario:
_ in Spalte A und B sind irgendeine Überschrift
_ in Spalte C bis E sollen Daten rein
_ Spalte F ist die von Dir angestrebte leere Spalte
_ ab G fängt den nächste Ablegebereich
Dann sollte es nicht ab Spalte G den End(..) angestossen, sondern ab Spalte F.
VG
Yal
AW: Wohin mit dem Code...
05.11.2021 10:36:09
B
Hallo Yal
Ich kriegs nicht zum laufen.
PS: Zeile start neu in Zeile 4

Sub CommandButton1_Click()
Select Case Me.Range("C2")
Case "AA": Kopieren Me.Name, "E", 17   'Ablegefeld von E bis U - Spalte V leer, Total 17 Spalten zu beschreiben
Case "AB": Kopieren Me.Name, "W", 17  'Ablegefeld von W bis AM - Spalte AN leer
Case "BB": Kopieren Me.Name, "AO", 8 '..von AO bis AV - AW leer
Case "B0": Kopieren Me.Name, "AX", 8
With Worksheets("Quelle")
Set Ziel_Zelle_erste = .Range(Ziel_Spalte_erste & Ziel_Zeile_erste)    'in Gruppe AA gehts hier zu Zelle E4
Set AnkerZelle = Ziel_Zelle_erste.Offset(0, Ziel_Spalten_Anzahl)         'die Ankerzelle wird V4, E4 + 17 nach rechts oder?
Set Paste_Zelle_erste = AnkerZelle.End(xlToLeft).Offset(0, 1)               'also schreibts zuerst in F4, wegen Offset 1, dann total 17x
If Paste_Zelle_erste.Column

Anzeige
Summenblatt erstellen
05.11.2021 11:35:19
Peter
Hallo,
eine interessante Aufgabe, die Du im Forum gestellt hast. Ich habe mal eine Lösung entwickelt - und dabei die bisherigen Code-Vorschläge nicht berücksichtigt. Bei meiner Lösung gehe ich davon aus, dass die Einzelblätter von anderen Mitarbeitern kommen und von Dir in die Datei eingefügt werden. Der Aufbau aller Einzelblätter muss identisch sein. Weiterhin gehe ich davon aus, dass zu jeder Hauptspalte (AA, AB, usw.) jeweils 4 Unterspalten gehören. Du kannst auch eine andere Anzahl wählen, aber mindestens 2. In diesem Fall sind einige Änderungen an verschiedenen Formeln und an den Makros vorzunehmen. Erläuterungen hierzu siehe im Blatt "Makrohinweise". Da die Einzelblätter so wie in Deinem Beispiel eintreffen werden, muss für jedes ankommende Blatt das entsprechende Bearbeitungswerkzeug bereitgestellt werden. Dies erreichst Du mit der Tastenkombination "STRG-w". Die Werkzeuge, ein Makrobutton und eine Formel, werden in dem sichtbaren Blatt eingefügt. Bei Betätigung des Makrobuttons werden die Werte in das Blatt "Sammlung" eingefügt. Die Arbeitsblätter "Test1" und "Test2" sind in meinem Beispiel schon eingefügt. Beim Arbeitsblatt "Test3" sind zwar die Werkzeuge vorhanden, aber die Hauptspalte "AD" ist im Blatt "Sammlung" noch nicht eingerichtet. Um dies zu tun, setzt Du den Cursor ganz einfach direkt hinter der gelb-unterlegten letzten vorhandenen Hauptspalte in Zelle "i4" und betätigst die Tastenkombination "STRG-e". Es wird daraufhin eine weitere Hauptspalte mit 4 Unterspalten eingefügt. Die Überschrift musst Du entsprechend abändern.
Hier meine Arbeitsmappe (Deine Beispielmappe mit den Ergänzungen):
https://www.herber.de/bbs/user/148961.xlsm
Bitte mal ausprobieren, Rückmeldung wäre schön.
Mit freundlichem Gruß
Peter Kloßek
Anzeige
AW: Summenblatt erstellen
06.11.2021 01:21:48
Peter
Hallo,
ich melde mich noch einmal. Natürlich geht die ganze Sache auch noch viel schneller. Ich habe die Makros zu einem automatischen Ablauf verknüpft. Diesen startest Du mit der Tastenkombination "STRG-a". Hier zunächst die ursprüngliche Datei mit der Automatic-Funktion.
https://www.herber.de/bbs/user/148969.xlsm
Ich habe natürlich gleich ausprobiert. Das Arbeitsblatt "Test3d" konnte nicht in die Sammlung eingefügt werden, weil dort kein Platz (für eine nicht vorhandene 5. Unterspalte) vorhanden war. Das Blatt "Test4" konnte ebenfalls nicht eingefügt werden, weil die entsprechende Hauptspalte in der Sammlung fehlte. Hier nun dieser Bearbeitungsstand.
https://www.herber.de/bbs/user/148970.xlsm
Ich habe daraufhin 2 Hauptspalten ergänzt: "AD_2" und "AC". Auf dem Blatt "Test3d" habe ich in der Zelle "B3" die Bezeichnung in "AD_2" geändert. Danach hatte ich erneut "STRG-a" betätigt. Das Ergebnis hier in der 3. Arbeitsmappe.
https://www.herber.de/bbs/user/148972.xlsm
Die einzelne Bearbeitung ist selbstverständlich weiterhin möglich. Wünsche noch viel Spass beim Testen.
M.f.G. Peter Kloßek
Mit einem abgeschnittenen Code ist wenig möglich
05.11.2021 19:29:05
Yal
Hallo B,
wenn wir uns zusammenreimen, was Du nicht postet, wird es schwierig.
Wenn das tatsächlich den Code ist, den Du verwendest, dann klar: es wird einen Sub "Kopieren" gerufen. Wo ist jetzt diese?
VG
Yal

Links zu Excel-Dialogen

CommandButton

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige