Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
428to432
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
428to432
428to432
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Übertrag mehrerer Zeilen einer Zelle

Übertrag mehrerer Zeilen einer Zelle
21.05.2004 18:49:15
Cordula
Hallo Excel-Freunde,
per VBA werden Daten einer Rechnung in eine andere Tabelle, fortlaufend, geschrieben. Diesen Code habe ich seinerzeit von Ramses bekommen (vielen Dank noch mal!) :

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Wachsende_Tabelle.xls").Worksheets(1)
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("G12").Value
wksTarget.Cells(iRow, 4).Value = wksSource.Range("C18").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("C17").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("F26").Value
End Sub

Das klappt wunderbar. ABER: Meine Rechnung beinhaltet 1 Zelle, in der der Rechnungsempfänger mit Alt+Enter mehrzeilig eingetragen wird. Nun möchte ich die 1. Zeile der Zelle in die "wachsende_Tabelle" in die Spalte G (iROW, 7) und die 2. Zeile der Zelle in die Spalte H (iRow, 8) übertragen lassen. Ist das möglich? Habe es schon mit dem Recorder probiert, leider ohne Erfolg :-(
Würde mich freuen, wenn Ihr mir helfen könntet.
Vielen Dank schon einmal!
LG
Cordula
AW: Übertrag mehrerer Zeilen einer Zelle
Ramses
Hallo
welche Zelle beinhaltet den Zeilenumbruch ?
Gruss Rainer
AW: Übertrag mehrerer Zeilen einer Zelle
Cordula
Hey Hallo Rainer,
der Empfänger steht in der Zelle A11
LG
Cordula
AW: Übertrag mehrerer Zeilen einer Zelle
Ramses
Hallo
probier mal das aus
Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Wachsende_Tabelle.xls").Worksheets(1)
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("G12").Value
wksTarget.Cells(iRow, 4).Value = wksSource.Range("C18").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("C17").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("F26").Value
wksTarget.Cells(iRow, 7).Value = _
Left(wksSource.Range("A11").Value, InStr(1, wksSource.Range("A11").Value, Chr$(10)))
wksTarget.Cells(iRow, 8).Value = _
Right(wksSource.Range("A11").Value, Len(wksSource.Range("A11").Value) - InStr(1, wksSource.Range("A11").Value, Chr$(10)))
End Sub

Gruss Rainer
Anzeige
AW: Übertrag mehrerer Zeilen einer Zelle
Cordula
Hey Rainer,
die 1 Zeile der Zelle wird korrekt in Spalte G eingetragen. In Spalte H steht allerdings der Rest der Adresse. Hier soll ja nur die 2. Zeile der Zelle stehen! Und nu? (Aber schon ziemlich gut! :-)
LG
Cordula
AW: Übertrag mehrerer Zeilen einer Zelle
Ramses
Hallo
dann musst du ja nur sicherstellen, dass jeder die Adresse richtig eingibt :-))
Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Dim chkStr As String
chkStr = wksSource.Range("A11").Value
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Wachsende_Tabelle.xls").Worksheets(1)
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("G12").Value
wksTarget.Cells(iRow, 4).Value = wksSource.Range("C18").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("C17").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("F26").Value
wksTarget.Cells(iRow, 7).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)))
chkStr = trim(Right(chkStr, Len(chkStr) - InStr(1, chkStr, Chr$(10))))
wksTarget.Cells(iRow, 8).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)))
End Sub

Gruss Rainer
Anzeige
AW: Übertrag mehrerer Zeilen einer Zelle
Cordula
Hey...... SICHER? kannst du nie sein! Beispiel: Die Übertragung der Daten geschieht ja, wenn der Anwender auf das Drucksymbol klickt, welches ich wiederum als Drucksymbol für den Aufruf des Druckmenüs hinterlegt habe. Klickt der AW auf dieses Symbol, gibt er die Anzahl der Kopien ein. Fertig! PUSTEKUCHEN.... Bei 5 Kopien ruft der AW 5x das Menü auf :-((( -trotz schriftlicher Anweisung! Noch Fragen?!! ;-)
Nichts desto trotz: Bei deinem Code erhalte ich die Meldung (sobald ich drucken möchte) Laufzeitfehler 91; Objektvariable oder With-Blockvariable nicht festgelegt
Und nu?!!!!
LG
Cordula
Anzeige
Sorry,... kleiner Lapsus
Ramses
Hallo Cordula
chkStr wurde zu früh initialisiert :-(
So geht es ...
Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Dim chkStr As String
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Wachsende_Tabelle.xls").Worksheets(1)
chkStr = wksSource.Range("A11").Value
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("G12").Value
wksTarget.Cells(iRow, 4).Value = wksSource.Range("C18").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("C17").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("F26").Value
wksTarget.Cells(iRow, 7).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)))
chkStr = Right(chkStr, Len(chkStr) - InStr(1, chkStr, Chr$(10)))
wksTarget.Cells(iRow, 8).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)))
End Sub

Gruss Rainer
Anzeige
AW: Sorry,... kleiner Lapsus
Cordula
Hey Rainer,
das ist suuuuper. Funktioniert! Bei der Übertragung wird aber die ALT+Enter -Schaltung mit übernommen (1 Zelle, 2 Zeilen aber nur die 1. ist ja beschrieben) bekommst du die auch noch weg? Nur eventuell... wenn möglich.... wäre klasse!
LG
Cordula
AW: Sorry,... kleiner Lapsus
Ramses
Hallo
Probier mal
Option Explicit

Private Sub Workbook_BeforePrint(Cancel As Boolean)
Dim wksSource As Worksheet, wksTarget As Worksheet
Dim iRow As Integer
Dim chkStr As String
Set wksSource = Worksheets("Rechnung")
Set wksTarget = Workbooks("Wachsende_Tabelle.xls").Worksheets(1)
chkStr = wksSource.Range("A11").Value
iRow = wksTarget.Cells(Rows.Count, 1).End(xlUp).Row + 1
wksTarget.Cells(iRow, 1).Value = wksSource.Range("B14").Value
wksTarget.Cells(iRow, 2).Value = wksSource.Range("G12").Value
wksTarget.Cells(iRow, 4).Value = wksSource.Range("C18").Value
wksTarget.Cells(iRow, 5).Value = wksSource.Range("C17").Value
wksTarget.Cells(iRow, 6).Value = wksSource.Range("F26").Value
wksTarget.Cells(iRow, 7).Value = Left(chkStr, InStr(1, chkStr, Chr$(10))-1)
chkStr = Right(chkStr, Len(chkStr) - InStr(1, chkStr, Chr$(10)))
wksTarget.Cells(iRow, 8).Value = Left(chkStr, InStr(1, chkStr, Chr$(10)))
End Sub

Gruss Rainer
Anzeige
Alles bestens Rainer! Vielen Dank! o.T.
Cordula
:-))))))))
Merci :-)) Geschlossen o.T.
Ramses
...

301 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige