Ich brauche eure Hilfe VBA Werte werden nicht über
31.07.2017 15:36:53
Hollandt
ich versuche mir gerade eine Lieferscheinerstellung zu automatisieren. Dabei möchte ich in einem Tabellenblatt "Übersicht" ein x an jede Position setzten, die ich dann auf dem LS haben will. Das Makro soll auf dem Tabellenblatt die Spalte L durchgehen und jedes Mal, wenn ein x gefunden wird, soll es die Daten aus den Spalten links daneben aufnehmen und in die Tabelle Lieferschein übertragen. Das ist die Kurzform. Drum herum wird dann noch die Adresse vom Ansprechpartner heraus gesucht und später soll die Datei als Excel abgespeichert und versendet werden. Das funktioniert soweit auch. Aber mein Problem ist, dass in dem Abschnitt, in dem die Daten in die dazugehörigen leeren Zellen auf dem Lieferschein eingetragen werden sollen, er mir nur die Artikelnummer und den Artikel einträgt. DIE FANR, Menge und Einheit werden nicht mit eingetragen. Könnt ihr mir da bitte behilflich sein? ps. Im oberen Teil mit dem CSTR habe ich eingefügt, weil ich jedes Mal Fehlermeldungen bezüglich der Variablen bekommen habe. Wahrscheinlich hat er die Stringzahlen in Integerwerte umgewandelt, weshalb ich auch das .value weg gelassen habe.
Sub LieferscheinErstellen()
Dim Ansprechpartner, Strasse, PLZ, Ort, Belegdatum As String
Dim Seite As Integer
Dim LSNR, Artikelnummer, Artikel, Einheit, Auswahl, FANR, Menge, Bestellnummer As String
Dim i, n, lfdnr As Integer
Sheets("Übersicht").Activate
' LSNR generieren ------------------------------------------------------------------------------------------'
Dim s As Integer
For s = 3 To Range("M3").End(xlDown).Row
Cells(s, 13).Select
If Selection.Offset(1, 0).Value = "" Then
lfdnr = Selection.Value
Exit For
End If
Next s
lfdnr = lfdnr + 1
LSNR = "LS" & "-" & Year(Date) & "-BSD-" & lfdnr
' LS erstellen ---------------------------------------------------------------------------------------------'
Dim zelle As Range
Dim bereich As Range
Set bereich = Range("L3:L500")
For Each zelle In bereich
If zelle.Value = "x" Then
zelle.Offset(0, 1).Value = lfdnr
zelle.Offset(0, -6).Value = LSNR
Artikelnummer = CStr(zelle.Offset(0, -7).Value)
Artikel = zelle.Offset(0, -8).Value
FANR = CStr(zelle.Offset(0, -3))
Menge = CStr(zelle.Offset(0, -1))
Einheit = "Stück"
Seite = "1"
Belegdatum = Date
Bestellnummer = zelle.Offset(0, -9)
Projekt = zelle.Offset(0, -11).Value
Ansprechpartner = zelle.Offset(0, -10).Value
' Adressdaten ermitteln ----------------------------------------------------------------------------------'
Sheets("Adressen").Activate
For n = 2 To Range("A2").End(xlDown).Row
Cells(n, 2).Select
If ActiveCell.Value = Ansprechpartner Then
Firma = ActiveCell.Offset(0, 1).Value
Strasse = ActiveCell.Offset(0, 2).Value
PLZ = ActiveCell.Offset(0, 3).Value
Ort = ActiveCell.Offset(0, 4).Value
End If
Next n
' Daten in Lieferschein oben eintragen --------------------------------------------------------------------'
Sheets("Lieferschein").Activate
Cells(11, 9).Value = Seite
Cells(13, 9).Value = Belegdatum
Cells(15, 9).Value = LSNR
Cells(17, 9).Value = Bestellnummer
Cells(2, 1).Value = Ansprechpartner
Cells(3, 1).Value = Firma
Cells(4, 1).Value = Strasse
Cells(5, 1).Value = PLZ & " " & Ort
Cells(9, 12).Value = Projekt
Cells(9, 12).Font.Name = "Arial"
Cells(9, 12).Font.Size = 14
Cells(9, 12).Font.Bold = True
'Leere Position auf Lieferschein finden ------------------------------------------------------------------------'
Dim m As Integer
Range("D21").Select
For m = 1 To 10
If ActiveCell.Value = "" Then
ActiveCell.Value = Artikelnummer
ActiveCell.Offset(0, 1).Value = Artikel
ActiveCell.Offset(0, 2).Value = FANR
ActiveCell.Offset(0, 3).Value = Menge
ActiveCell.Offset(0, 4).Value = Einheit
Exit For
End If
ActiveCell.Offset(1, 0).Select
Next m
End If
Sheets("Übersicht").Activate
Next zelle