[Erledigt] Zellinhalte in anderes Tabellenblatt schieben

[teresa]

Hallo,

ich hatte mein Anliegen bereits hier gepostet.

ich habe im Dokument 2 Tabellenblätter ... CFD und CFD2010.
In CFD gebe ich pro Monat die Daten ein. Von A8 - AB8.
In CFD2010 sollen alle Daten des laufenden Jahres rein.

Ich möchte es so realisieren, dass ich per Schaltfläche - oder wie auch immer - die markierten Zeilen aus Tabelle CFD in CFD2010 übertrage.
Parallel sollen die übertragenen Inhalte der markierten Zeilen aus den nicht geschützten CFD Bereichen gelöscht werden.

Mit markierten Zeilen meine ich die Spalten A - AB der markierten Zeilen.

Das sollte per Makro möglich sein. Leider habe ich absolut keine Ahnung, wie ich es anstelle.

Gruss

[Charly]

Hallo Teresa!

Da ich dein Dokument und alle Anforderungen nicht kenne, habe ich jetzt mal ins Blaue hinein eine Calcdatei mit Makro erstellt. Vielleicht passt es so.

Gruß
Charly

[teresa]

Herzlichen Dank für den Code.

Leider läuft es bei mir nicht. Ich erhalte die Fehlermeldung: BASIC Laufzeitfehler. Objektvariable nicht belegt.
Auch nach div. Änderungsversuchen läuft nix.
Die Zeile "Anfang = Quelle.Startrow" wird makiert.
Ich finde mom. keine Lösung, da ich mich erst kurze Zeit mit oo beschäftige

Hab jetzt mal die komplette Datei im Anhang hochgeladen.

Gruss

[Charly]

Hallo Teresa!

Da ist mir ein Fehler unterlaufen. Ich habe nach dem Testen versehentlich einen Befehl gelöscht, der für den Ablauf notwendig ist.

Allerdings habe ich auch Probleme mit deiner Datei, weil die Tabellenblätter mit einem Code geschützt sind. Daher kann ich mit dem Makro weder kopieren noch löschen. Ich müsste in das Makro noch die Aufhebung des Schutzes und und neu schützen einstellen.

Ich habe auch noch eine Frage zum Tabellenblatt CFD2010. Hier sind bereits Zeilen belegt. Ich habe so programmiert, dass der Übertrag in die nächste freie Zeile kommt. Das funktioniert natürlich nicht, wenn die Daten in bereits ausgefüllten Zeilen kommen sollen. Sehe ich das so richtig.

Ich werde deine Datei mal in eine neue Calc-Datei rüberkopieren und mein Makro anpassen.

Hier vorerst der berichtigte Code:

Code: Alles auswählen

Sub Uebertragen()

Dok = Thiscomponent

'Selektierten Bereich ermitteln
Quellbereich = Dok.getCurrentSelection()
Quelle = Quellbereich.getRangeAddress

'Anfang und Ende der markierten Zeilen finden - nur notwendig,
'wenn nicht ganze Zeile kopiert und gelöscht werden darf

Anfang = Quelle.Startrow
Ende = Quelle.Endrow
Nr = Quelle.sheet
Quellbereich = Dok.sheets(Nr).getCellRangeByPosition(0,Anfang,27,Ende)

'Quelladdresse ermitteln
Quelle = Quellbereich.getRangeAddress 

'nächste freie Zeile für den Übertrag finden
Zielblatt = Dok.sheets.getByName("CFD2010")
Cursor = Zielblatt.createCursor()
Cursor.gotoEndOfUsedArea(False)
Zeile = cursor.getRangeAddress().endrow+1

Ziel = Zielblatt.getCellByPosition(0,Zeile).getCellAddress()

'Kopieren
Zielblatt.copyRange(Ziel, Quelle)

'Inhalte vom Quellbereich löschen
Quellbereich.clearcontents(23)


End Sub

Gruß
Charly

[Charly]

Hallo Teresa!

Ich habe das Makro nach deinem Formblatt angepasst. Statt kopieren übertrage ich jetzt die Daten in das Tabellenblatt "CFD2010", damit die unterschiedlichen Formatierungen erhalten bleiben. Die Formeln im Zielblatt werden allerdings im Moment überschrieben durch die Werte der Quelltabelle. Wird dies nicht gewünscht, muss die Datenübertragung in Teilschritten erfolgen. Dazu muss ich allerdings genau wissen welche Spalten nicht überschrieben werden dürfen.

Ich habe meine Tabellen mit dem Passwort "test" geschützt. Dieses Passwort wird vom Makro aufgehobe und am Schluss wieder gesetzt.

Gruß
Charly

[teresa]

Hallo Charly,

WOW !!!
ich bin begeistert.

Die Formeln im Zielblatt müssen nicht erhalten bleiben. Es sollen lediglich Werte erscheinen, was der Fall ist.

Im Blatt CFD werden momentan die Formeln gelöscht, wollte ich vermeiden.
Da ich nicht nur kopieren, sondern auch etwas lernen möchte, benötige ich einen "Denkanstoss", den ich auf weitere Spalten umsetzen kann.


Gruss

[Charly]

Hallo Teresa!

Schön, dass dir das Makro gefällt.

Im Blatt CFD werden momentan die Formeln gelöscht, wollte ich vermeiden.

Wenn du im Quellblatt die Formeln erhalten willst, ist das kein Problem. Du musst nur folenden Befehl ändern:

Code: Alles auswählen

'Inhalte vom Quellbereich löschen
Quellbereich.clearcontents(23)

Die 23 in der Klammer besagt, daß Text, Datum, Zahlen und Formeln gelöscht werden sollen. Die Ziffer 16 steht dabei für Formeln. Schreibe also statt 23 die Ziffer 7.

Code: Alles auswählen

'Inhalte vom Quellbereich löschen
Quellbereich.clearcontents(7)

Gruß
Charly

[teresa]

Hallo Charly,

es klappt wunderbar und ist haargenau das, was ich gesucht hatte.
Ohne die Hilfe hätte ich es nichtmal ansatzweise geschafft.

Vielen Dank nochmals.


Gruss

[joesch]

Hallo zusammen,

wie kann ich das Makro derrt anpassen, dass keine Format sondern nur die in den Quellzellen errechneten Werte übertragen werden? Habe aktuell das Problem, dass bei einer Quellzelle, die aus verbundenen Zellen besteht, auch in der Zieltabelle die Zellen verbunden werden.

Vielen Dank schon mal und VG - Joesch

[turtle47]

Hallo Joesch,

dass bei einer Quellzelle, die aus verbundenen Zellen besteht, auch in der Zieltabelle die Zellen verbunden werden.

wenn Du unter diesen Ümständen Zellen auf diese Art und Weise kopierst wirst Du das nicht auschliessen können.
Da muss man anders rangehen. Beschreibe doch mal genauer den Quell- und Zielbereich oder hänge hier im Forum ein Beispiedokument an.

Sensible Daten aber bitte vorher löschen.

Jürgen

[joesch]

Vielen Dank für deine Rückmeldung.
Die Datei habe ich angehängt. Momentan läuft sie so, dass in der Tabelle Teilnehmer bei Klick auf Quittung der jeweils zuvor markierte Teilnehmer (Namensfeld) mit dem in der Zeile ausgewiesenen Betrag in die Quittung übernommen wird. Eine Quittung kann bis zu 4 Teilnehmer aufnehmen.
Nun möchte ich nach dem Drucken für jeden (also 1, 2, 3 oder 4) der in der Quittung stehenden Teilnehmer je eine Zeile in der Quittungsliste erstellen.
Dabei sollen die Felder $E10 ff. mit dem Namen, $J10 ff. mit dem Verein sowie der in $N10 aufgeführte Einzelbetrag in die jeweils letzte (bzw. erste freie) Zeile der Quittungsliste geschrieben werden. Schön wäre es, wenn sich die Zelle M4 (Quittungsnummer) mit übertragen ließe. Diese wäre also u.U. für mehrere Teilnehmer (wenn auf einer Quittung) gleich.

Danke schon mal und VG - Joesch

[turtle47]

Hi Joesch,

[Nörgelmodus an]
Als ich die Tabellen in der Datei gesehen habe, hatte ich schon gar keine Lust anzufangen.
Da stimmen teilweise die Formeln nicht oder die Formatierungen der Zellen lassen zu wünschen übrig.
[Nörgelmodus aus]

Hier der Code zum Übertragen der Inhalte:

Code: Alles auswählen

Global G_Sheet as Object
Sub CopyCellRange
    Q_Sheet = ThisComponent.getSheets.getbyName("Quittung")
    G_Sheet = ThisComponent.getSheets.getbyName("Quittungsliste")
    for i = 10 to 13 'Counter für Zeile 10 bis 13     
    Q_cell = Q_Sheet.getCellRangeByName("E" & i)
        if Q_cell.string <> "" Then
            k = lastRow 'letzte Zeile über Function ermitteln
            'folgend Quittungsnummer als Text übertragen
            G_Sheet.getCellRangeByName("A" & k).String = Q_Sheet.getCellRangeByName("M4").String
            'alterntiv folgend Quittungsnummer als Zahl übertragen
            'G_Sheet.getCellRangeByName("A" & k).value = Q_Sheet.getCellRangeByName("M4").value    
            'folgend Datum übertragen
            G_Sheet.getCellRangeByName("B" & k).value = Q_Sheet.getCellRangeByName("K16").value
            'folgend Name übertragen
            G_Sheet.getCellRangeByName("C" & k).string = Q_cell.string
            'folgend Verein übertragen
            G_Sheet.getCellRangeByName("F" & k).string = Q_Sheet.getCellRangeByName("J" & i).String    
            'folgend Betrag übertragen
            G_Sheet.getCellRangeByName("D" & k).value = Q_Sheet.getCellRangeByName("G5").value
        end if
    next
End Sub

Function lastRow as integer
      oCellCursor = G_Sheet.createCursor()
    oCellCursor.GotoEndOfUsedArea(True)    
    End_Row = oCellCursor.getRangeAddress.EndRow
    lastRow = End_Row +2
End Function

Jürgen

[joesch]

[Nörgelmodus an]
... Da stimmen teilweise die Formeln nicht ...
[Nörgelmodus aus]

Sorry, da hatte ich deinem Hinweis auf das Löschen unnötiger Daten zu genau genommen und versehentlich eien Tabelle weggelöscht, auf die noch Zellbezüge gesetzt waren.

Um so mehr ein großes Dankeschön an dich, da mir dein Quelltext sehr geholfen hat. Die so ergänzte Datei mit der fehlenden Tabelle zur Nachnutzung bei Bedarf daher noch mal anbei.

VG - Joesch