AW: Daten übertragen
08.07.2008 10:43:29
fcs
Hallo Dieter,
hier ein Vorschlag, der die Zeilen 31 bis 44 im Rechnungsblatt in einer Schleife abarbeitet.
zusätzlich wird geprüft ob eine Artikelnummer eingetragen ist.
Gruß
Franz
Sub EingabeDaten_nach_Rg_Buch()
Dim wksRechnung As Worksheet, wksRg_Buch As Worksheet, lngZeile As Long
Dim varRechnungsNr, varKundenNr, datDatum As Date
Dim lngZeileRng As Long
Set wksRechnung = ActiveWorkbook.Sheets("Rechnung")
Set wksRg_Buch = ActiveWorkbook.Sheets("Rg_Buch")
'Letzte Zeile im Rechnungslog
lngZeile = wksRg_Buch.Cells(wksRg_Buch.Rows.Count, 1).End(xlUp).Row
' Daten übertragen
varRechnungsNr = wksRechnung.Range("B23").Value 'Rechnunsnummer
varKundenNr = wksRechnung.Range("D23").Value 'Kundennummer
varDatum = wksRechnung.Range("G23").Value 'datum
With wksRechnung
For lngZeileRng = 31 To 44 'Zeilen im Blatt Rechnung
'prüfen ob Artikelnummer in Zeile vorhanden
If .Cells(lngZeileRng, 2).Value "" Then 'Artikelnummer
lngZeile = lngZeile + 1 'Nächste Zeile im Blatt RgBuch
wksRg_Buch.Cells(lngZeile, 1).Value = varRechnungsNr 'Rechnunsnummer
wksRg_Buch.Cells(lngZeile, 2).Value = varKundenNr 'Kundennummer
wksRg_Buch.Cells(lngZeile, 3).Value = varDatum 'datum
wksRg_Buch.Cells(lngZeile, 4).Value = .Cells(lngZeileRng, 2).Value 'Artikelnummer
wksRg_Buch.Cells(lngZeile, 5).Value = .Cells(lngZeileRng, 3).Value 'Produkt
wksRg_Buch.Cells(lngZeile, 6).Value = .Cells(lngZeileRng, 6).Value 'Stückzahl
wksRg_Buch.Cells(lngZeile, 7).Value = .Cells(lngZeileRng, 7).Value 'Einzelpreis
wksRg_Buch.Cells(lngZeile, 8).Value = .Cells(lngZeileRng, 8).Value 'GesamtNetto
wksRg_Buch.Cells(lngZeile, 9).Value = .Cells(lngZeileRng, 9).Value 'Mwst
wksRg_Buch.Cells(lngZeile, 10).Value = .Cells(lngZeileRng, 10).Value 'GesamtBrutto
End If
Next
If .Range("J49").Value 0 Then 'Versandgebühren
lngZeile = lngZeile + 1
wksRg_Buch.Cells(lngZeile, 1).Value = varRechnungsNr 'Rechnunsnummer
wksRg_Buch.Cells(lngZeile, 2).Value = varKundenNr 'Kundennummer
wksRg_Buch.Cells(lngZeile, 3).Value = varDatum 'datum
wksRg_Buch.Cells(lngZeile, 11).Value = .Range("J49").Value 'Versandgebühren
End If
If .Range("J50").Value 0 Then 'Versandkosten
lngZeile = lngZeile + 1
wksRg_Buch.Cells(lngZeile, 1).Value = varRechnungsNr 'Rechnunsnummer
wksRg_Buch.Cells(lngZeile, 2).Value = varKundenNr 'Kundennummer
wksRg_Buch.Cells(lngZeile, 3).Value = varDatum 'datum
wksRg_Buch.Cells(lngZeile, 12).Value = .Range("J50").Value 'Versandkosten
End If
If .Range("J51").Value "" Then 'Sendungsdaten
lngZeile = lngZeile + 1
wksRg_Buch.Cells(lngZeile, 1).Value = varRechnungsNr 'Rechnunsnummer
wksRg_Buch.Cells(lngZeile, 2).Value = varKundenNr 'Kundennummer
wksRg_Buch.Cells(lngZeile, 3).Value = varDatum 'datum
wksRg_Buch.Cells(lngZeile, 13).Value = .Range("J50").Value 'Sendungsdaten
End If
End With
'Datei speichern
ActiveWorkbook.Save
'einige Eingabefelder leeren für nächste Eingabe
wksRechnung.Range("D23").ClearContents 'Kundennummer
wksRechnung.Range("B31:B44").ClearContents 'Artikelnr. '### prüfen, ob so OK
wksRechnung.Range("F31:F44").ClearContents 'Stückzahl '### prüfen, ob so OK
wksRechnung.Range("J49").ClearContents 'Versandgebühren
wksRechnung.Range("J50").ClearContents 'Versandkosten
wksRechnung.Range("J51").ClearContents 'Sendungsdaten
MsgBox "Daten wurden übertragen."
End Sub