Live-Forum - Die aktuellen Beiträge
Datum
Titel
24.04.2024 04:37:43
Mit Word erstellte PDF als Anhang an E-Mail anhängen
24.04.2024 00:20:14
Bestimmte Spalten als xls exportieren per Makro
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1044to1048
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
1044to1048
1044to1048
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Daten uebertragen aus Listbox

Daten uebertragen aus Listbox
01.02.2009 18:43:00
SoulOpa
Hallo Excelgemeinschaft,
ich habe eine Frage wie kann ich folgenden Code erweitern? Ich würde gerne aus dem Tabellenblatt Rechnung Zelle [C18] die Rechnungsnummer in das Datenblatt mit dem Namen Rechnungsnummern Zelle [C2] übertragen und dann die Nächste Rechnungsnummer fortlaufend in Celle [C3] [C4] und so weiter.

Private Sub CommandButton4_Click()
'Fehlerhinweis beim Kopieren in Rechnungsverwaltung wenn kein Endbetrag eingetragen wurde()
If Range("C10") = "" Then 'Zelle Kuden Adresse
MsgBox "Bitte Kunden auswählen"
Else
If Range("K123") = "0" Then
MsgBox "Achtung kein Endbetrag vorhanden! Rechnung kann nicht in Rechnungsverwaltung abgelegt   _
_
werden. Bitte einen Betrag eingeben"
Exit Sub
End If
'Rechnungsdaten in Rechnungsverwaltung übertragen()
If ActiveSheet.Name  "Rechnung" Then Exit Sub
Dim freeR As Integer
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Rechnung")
Set wks2 = Worksheets("Rechnungsverwaltung")
freeR = wks2.Cells(65536, 1).End(xlUp).Row + 1
wks2.Cells(freeR, 1) = wks1.[C10]   'Kunde
wks2.Cells(freeR, 2) = wks1.[C18]   'Rechnungsnummer
wks2.Cells(freeR, 3) = wks1.[F18]   'Rechnungsdatum
wks2.Cells(freeR, 4) = wks1.[K123]  'Rechnungsbetrag o. Skonto
wks2.Cells(freeR, 5) = wks1.[H126]  'Rechnungsbetrag mit Skonto
wks2.Cells(freeR, 6) = wks1.[J18]   'Zahlungsziehl
MsgBox "Rechnungs Daten wurden erfolgreich in Rechnungsverwaltung übertragen"
End If
Exit Sub
End Sub


Danke für Eure Hilfsbereitschaft
mfg Andi

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Daten uebertragen aus Listbox
01.02.2009 19:49:01
Erich
Hallo Andi,
probier mal 

Option Explicit
Private Sub CommandButton4_Click()
Dim freeR As Long     ' besser Long als Integer
If ActiveSheet.Name  "Rechnung" Then Exit Sub
'Fehlerhinweis beim Kopieren in Rechnungsverwaltung,
'wenn kein Endbetrag eingetragen wurde()
If Range("C10") = "" Then  'Zelle Kunden Adresse
MsgBox "Bitte Kunden auswählen"
Exit Sub
End If
If Range("K123") = "0" Then
MsgBox "Achtung kein Endbetrag vorhanden!" & vbLf & _
"Rechnung kann nicht in Rechnungsverwaltung abgelegt werden." & vbLf & _
"Bitte einen Betrag eingeben"
Exit Sub
End If
'Rechnungsdaten in Rechnungsverwaltung übertragen
With Worksheets("Rechnungsverwaltung")
freeR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(freeR, 1) = Range("C10")     'Kunde
.Cells(freeR, 2) = Range("C18")     'Rechnungsnummer
.Cells(freeR, 3) = Range("F18")     'Rechnungsdatum
.Cells(freeR, 4) = Range("K123")    'Rechnungsbetrag o. Skonto
.Cells(freeR, 5) = Range("H126")    'Rechnungsbetrag mit Skonto
.Cells(freeR, 6) = Range("J18")     'Zahlungsziehl
MsgBox "Rechnungs Daten wurden erfolgreich in Rechnungsverwaltung übertragen"
End With
'Rechnungsnummer übertragen
With Worksheets("Rechnungsnummern")
freeR = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(freeR, 3) = Range("C18")     'Rechnungsnummer
MsgBox "Rechnungsnummer wurde erfolgreich übertragen"
End With
'   Exit Sub  ' ist hier sicher unnötig
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Anzeige
AW: Daten uebertragen aus Listbox
01.02.2009 20:07:54
SoulOpa
Hallo Erich,
danke für Deine Hilfe.
so habe Deinen Code eingfügt bekomme aber gleich eine Fehler meldung Fehler beim Komplimieren Variable nicht definiert.
With Worksheets("Rechnungsverwaltung")
freeR = .Cells(.Rows.Count, 1).End(xlUp).Row + 1 MELDUNG HIER
.Cells(freeR, 1) = Range("C10") 'Kunde
.Cells(freeR, 2) = Range("C18") 'Rechnungsnummer
.Cells(freeR, 3) = Range("F18") 'Rechnungsdatum
.Cells(freeR, 4) = Range("K123") 'Rechnungsbetrag o. Skonto
.Cells(freeR, 5) = Range("H126") 'Rechnungsbetrag mit Skonto
.Cells(freeR, 6) = Range("J18") 'Zahlungsziehl
MsgBox "Rechnungs Daten wurden erfolgreich in Rechnungsverwaltung übertragen"
End With
'Rechnungsnummer übertragen
With Worksheets("Rechnungsnummern")
freeR = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(freeR, 3) = Range("C18") 'Rechnungsnummer
MsgBox "Rechnungsnummer wurde erfolgreich übertragen"
End With
End Sub
Danke
Anzeige
AW: Rückfrage
01.02.2009 20:13:37
Erich
Hi Andi,
WO hast du denn den Code eingefügt?
Aus meiner Sicht habe ich dir die komplette Routine CommandButton4_Click gepostet,
und da wird ganz am Anfang mit der Zeile
Dim freeR As Long ' besser Long als Integer
die Variable freeR deklariert. Ich weiß jetzt nicht, wie das Problem bei dir entsteht.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
AW: Daten uebertragen aus Listbox
01.02.2009 20:17:15
SoulOpa
Hallo Erich
ich habe es jetzt so gelöst und es Funktioniert! kannst Du das noch einmal überprüfen? ob das so weit Inordnung ist.

Private Sub CommandButton4_Click()
'Fehlerhinweis beim Kopieren in Rechnungsverwaltung wenn kein Endbetrag eingetragen wurde()
If Range("C10") = "" Then 'Zelle Kuden Adresse
MsgBox "Bitte Kunden auswählen"
Else
If Range("K123") = "0" Then
MsgBox "Achtung kein Endbetrag vorhanden! Rechnung kann nicht in Rechnungsverwaltung abgelegt  _
werden. Bitte einen Betrag eingeben"
Exit Sub
End If
'Rechnungsdaten in Rechnungsverwaltung übertragen()
If ActiveSheet.Name  "Rechnung" Then Exit Sub
Dim freeR As Integer
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Rechnung")
Set wks2 = Worksheets("Rechnungsverwaltung")
freeR = wks2.Cells(65536, 1).End(xlUp).Row + 1
wks2.Cells(freeR, 1) = wks1.[C10]   'Kunde
wks2.Cells(freeR, 2) = wks1.[C18]   'Rechnungsnummer
wks2.Cells(freeR, 3) = wks1.[F18]   'Rechnungsdatum
wks2.Cells(freeR, 4) = wks1.[K123]  'Rechnungsbetrag o. Skonto
wks2.Cells(freeR, 5) = wks1.[H126]  'Rechnungsbetrag mit Skonto
wks2.Cells(freeR, 6) = wks1.[J18]   'Zahlungsziehl
MsgBox "Rechnungs Daten wurden erfolgreich in Rechnungsverwaltung übertragen"
End If
Dim LoLetzte As Long
With Worksheets("Rechnungsnummern")
freeR = .Cells(.Rows.Count, 3).End(xlUp).Row + 1
.Cells(freeR, 3) = Range("C18")     'Rechnungsnummer
MsgBox "Rechnungsnummer wurde erfolgreich übertragen"
MsgBox "Rechnungsnummer wurde erfolgreich übertragen"
End With
End Sub


Anzeige
AW: Daten uebertragen aus Listbox
01.02.2009 21:11:01
Reinhard
Hallo Andi,
benutze bitte Einrückungen des Codes durch Leerstellen, viel besser lesbar.
Alle Dim immer, Set sofern möglich, ganz vorne in den Code.
Zeilen nie als Integer, gleich als Long.
Nachfolgend ist nochmal dein ganz am Anfang geposteter Code, ich hatte ihn auch formatiert/geändert, so wie Erich.
Schau dir den von mir und Erich an und dann dein Ausgangscode und vergleiche was wir anders machten.
Naja, Erich war schneller, ich kma gar nicht dazu in deinen Code den ich grad formatiert/geändert hatte auch noch das einzubauen warum du eigentlich angefragt hattest :-)
Gruß
Reinhard

Private Sub CommandButton4_Click()
Dim freeR As Long
Dim wks1 As Worksheet, wks2 As Worksheet
Set wks1 = Worksheets("Rechnung")
Set wks2 = Worksheets("Rechnungsverwaltung")
'Fehlerhinweis beim Kopieren in Rechnungsverwaltung wenn kein Endbetrag eingetragen wurde()
If Range("C10") = "" Then 'Zelle Kuden Adresse
MsgBox "Bitte Kunden auswählen"
Else
If Range("K123") = "0" Then
MsgBox "Achtung kein Endbetrag vorhanden!" & Chr(13) & _
"Rechnung kann nicht in Rechnungsverwaltung abgelegt werden. " & Chr(13) & _
"Bitte einen Betrag eingeben"
Exit Sub
End If
'Rechnungsdaten in Rechnungsverwaltung übertragen()
If ActiveSheet.Name  "Rechnung" Then Exit Sub
freeR = wks2.Cells(65536, 1).End(xlUp).Row + 1
wks2.Cells(freeR, 1) = wks1.[C10]   'Kunde
wks2.Cells(freeR, 2) = wks1.[C18]   'Rechnungsnummer
wks2.Cells(freeR, 3) = wks1.[F18]   'Rechnungsdatum
wks2.Cells(freeR, 4) = wks1.[K123]  'Rechnungsbetrag o. Skonto
wks2.Cells(freeR, 5) = wks1.[H126]  'Rechnungsbetrag mit Skonto
wks2.Cells(freeR, 6) = wks1.[J18]   'Zahlungsziehl
MsgBox "Rechnungs Daten wurden erfolgreich in Rechnungsverwaltung übertragen"
End If
End Sub


Anzeige
AW: Daten uebertragen aus Listbox
01.02.2009 20:21:26
SoulOpa
Hallo Erich,
stop Dein Code Funktioniert einwandfrei. War zu schnell mit dem Kopieren und einfügen.
Ich hätte noch ein wenig Zeit gebraucht dann währe ich auch darauf gekommen. Aber als Anfänger bin ich froh das ich hier immer jemanden finde der sich die Zeit und mühe macht um mir und anderen zu helfen.
Danke Erich

Links zu Excel-Dialogen

CommandButton ListBox

Beliebteste Forumthreads (12 Monate)

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

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige