Microsoft Excel

Herbers Excel/VBA-Archiv

Codeerweiterung

Betrifft: Codeerweiterung von: HenryG
Geschrieben am: 20.09.2004 01:16:49

Hallo,
freundlicherweise hat Rainer(Ramses) mir unten aufgeführten Code,
meinen Bedürfnissen angepasst.
Nun ist mir noch zusätzlich der Gedanke gekommen, diese eingefügten
Informationen in entsprechenden Blättern aufzuteilen.
Obwohl ich im Grunde null Ahnung von VBA habe, möchte ich es gerne
auf diese Weise lösen.
Um eine Identifizierung der Zeilen zu ermöglichen, die in den entsprechenden
Blättern aufgeteilt werden sollen, habe ich über SVERWEIS Zahlen entsprechend
der Information über den Code in Spalte A mit einfügen lassen.
Jetzt wäre es schön, wenn man diesen Code um folgendes erweitern könnte:
Nach oder besser noch während die Informationen via Code übertragen werden,
soll die Zeile (C:G), wo eine 1 in Spalte A steht in Blatt (1), 2 Blatt (2) und
3 in Blatt (3) übertragen werden.
Könnte jemand von euch, diesen Code um diese Funktion erweitern?
Gruß
Henry

Sub Datenuebernahme()
    Sheets("Test1").Select
Dim laR As Long
    laR = Cells(Rows.Count, 7).End(xlUp).Row
    Cells(laR + 1, 1).Value = Sheets("Tabelle3").Range("D6").Value
    Sheets("Tabelle3").Range("D6").Value = ""
    Cells(laR + 1, 2).Value = Sheets("Tabelle3").Range("D9").Value
    Sheets("Tabelle3").Range("D9").Value = ""
    Cells(laR + 1, 3).Value = Sheets("Tabelle3").Range("AC3").Value
    Cells(laR + 1, 4).Value = Sheets("Tabelle3").Range("AC4").Value
    Cells(laR + 1, 5).Value = Sheets("Tabelle3").Range("D12").Value
    Sheets("Tabelle3").Range("D12").Value = ""
    Cells(laR + 1, 6).Value = Sheets("Tabelle3").Range("H12").Value
    Sheets("Tabelle3").Range("H12").Value = ""
    Cells(laR + 1, 7).Value = Sheets("Tabelle3").Range("L12").Value
    Sheets("Tabelle3").Range("L12").Value = ""
    Cells(laR + 1, 8).Value = Sheets("Tabelle3").Range("D15").Value
    Sheets("Tabelle3").Range("D15").Value = ""
    Cells(laR + 1, 9).Value = Sheets("Tabelle3").Range("H15").Value
    Sheets("Tabelle3").Range("H15").Value = ""
    Cells(laR + 1, 10).Value = Sheets("Tabelle3").Range("L15").Value
    Sheets("Tabelle3").Range("L15").Value = ""
    Sheets("Tabelle3").Range("Y1").Value = 1
    Sheets("Tabelle3").Range("AA1").Value = 1
End Sub

  


Betrifft: AW: Codeerweiterung von: Andre
Geschrieben am: 20.09.2004 09:10:45

Hi Henry,

zum Verständnis: es werden mit diesem Code aber nicht mehrere Zeilen übertragen, sondern nur immer eine Zeile aus den entsprechenden Zellen erstellt!?

Welche Zeilen sollen denn zusätzlich "kopiert" werden und sollen diese Zeilen dann unter dieser stehen? Oder hat das eine nicht direkt was mit dem andreren zu tun?

mfg Andre


  


Betrifft: AW: Codeerweiterung von: HenryG
Geschrieben am: 20.09.2004 09:51:47

Guten Morgen Andre,
entschuldige bitte, die etwas verwirrende Beschreibung.
Du siehst das schon Richtig!
Aus der Tabelle3 werden die im Code aufgeführten Zellen
in das Sheet "Test1" übermittelt. Nach der Übermittlung
sind alle Zellen in Blatt3 wieder leer! Jeder erneute
Übertrag wird in der nächsten freien Zeile(Test1) eingetragen.
Es entsteht also immer nur eine neue Zeile.
Kopiert werden sollte die Zeile sofort/während des Übertrags
und zwar nur einmal.(Der Eintrag aus Tabelle3(C:G))
Mit jedem Übertrag erscheint in Spalte A(Tabelle3)der jeweiligen Zeile
eine Zahl, die als Kennung für die Verteilung in den verschieden
Shett´s dienen soll.
Wenn 1, dann Sheet"1", wenn 2,dann Sheet"2" und wenn 3, dann Sheet"3".
Die Einträge dort sollen dort dann auch untereinander weiter geführt
werden.
Ich weiß, Erklärung ist nicht unbedingt meine Stärke, hoffe aber,
das du damit weiterkommst.
Gruß
Henry


  


Betrifft: AW: Codeerweiterung von: Andre
Geschrieben am: 20.09.2004 10:33:48

Hi nochmal,

hoffe, ich hab das jetzt richtig auf die Reihe bekommen!

Hier mal ´ne Beispiel-datei: https://www.herber.de/bbs/user/11077.xls

In Tabelle3 Zelle A1 steht hier das Kennzeichen. Mit dem Button löst du das Ereignis aus.
Die Löschung der Quellzellen hab ich erst einmal auskommentiert, damit man das Spielchen schnell mal wiederholen kann, ohne die Daten immer wieder eingeben zu müssen.

Hab mir erlaubt, deinen Code noch etwas zu vereinfachen und umzustellen.

mfg Andre


  


Betrifft: Fast Perfekt von: HenryG
Geschrieben am: 20.09.2004 10:51:35

Hallo Andre,
vielen Dank für Deine Mühe!
So habe ich es mir vorgestellt,
aber:
In Deinem Beispiel findet der Übertrag in Blatt"Test1" und Blatt"2" statt.
"Test1" ist O.K. Blatt"2", die Zeile wird leider überschrieben, sollte aber
wenn es geht, wie in "Test1" funktionieren, also immer untereinander.
Könntest Du vielleicht noch einmal nach schauen?
Vielen Dank
Gruß
Henry


  


Betrifft: AW: Fast Perfekt von: Andre
Geschrieben am: 20.09.2004 11:19:49

Sorry Henry, mein Fehler!

Ersetzte folgende Zeile:

LetzteZeile = .Cells(Cells.Rows.Count, 1).End(xlUp).Row

mit dieser:

LetzteZeile = .Cells(Cells.Rows.Count, 1).End(xlUp).Row + 1

Dann geht´s.

Viel Spaß damit. Gruß Andre


  


Betrifft: Großes Lob & Vielen Dank :) o.T. von: HenryG
Geschrieben am: 20.09.2004 11:44:28

.