Mit Inputbox bestimmte Werte in Maske
12.03.2015 13:17:48
Marcel
Ich habe da ein kleines Problem vielleicht stelle ich mich auch ein wenig doof an.
Ich habe eine Kasse für mein Laden erstellt nun tüftle ich ein Wenig an Makros rum.
Ein paar habe ich auch schon hinbekommen. Nur komme ich bei einem nicht ganz klar.
Und zwar möchte ich mit Hilfe einer Inputbox bestimmte Werte wie Betrag Datum etc. in eine Vorlage(Rechnung/Bon) übertragen. Ich gebe Quasi die Kundennummer(aus lfd. Nr.des Kunden) ein und möchte die kompletten Daten dieses Kunden in eine Rechnungsvorlage übertragen. Bisher habe ich es hinbekommen einen neuen Sheet zu öffnen und dort alle Daten dann zu übertragen und sogar eine Summe zu erstellen ;-). Nur löscht sich diese Eingabe danach wieder.
Ich Danke schonmal im vorraus
Public Sub Spaß()
Application.ScreenUpdating = False
Dim myRange As Range
Dim strAddress As String
Dim lngCounter As Long
Dim letzteZeile As Integer
Dim spaltefuersumme As Integer
Dim eingabe As Integer
eingabe = InputBox("Geben Sie die Nummer des zu berechnenden Kunden ein.", "Kundenauswahl")
Set myRange = Worksheets("Übersicht").Columns(2).Find(What:=eingabe, After:=Worksheets("Ü _
bersicht").Cells(Rows.Count, 2), LookAt:=xlWhole)
If Not myRange Is Nothing Then
strAddress = myRange.Address
Do
lngCounter = lngCounter + 1
With Worksheets("aktueller Kunde")
.Range(.Cells(.Cells(Rows.Count, 4).End(xlUp).Row + 1, 1),
.Cells(.Cells(Rows.Count, 4).End(xlUp).Row + 1, 256)) =
Worksheets("Übersicht").Range(Worksheets("Übersicht").Cells(myRange.Row, 1),
Worksheets("Übersicht").Cells(myRange.Row, 256)).Value
End With
Set myRange = Worksheets("Übersicht").Columns(2).FindNext(myRange)
Loop While Not myRange Is Nothing And myRange.Address strAddress
Else
End If
Worksheets("aktueller Kunde").Activate
ActiveSheet.Columns("A").Delete
ActiveSheet.Columns("E:CN").Delete
ActiveSheet.Columns("F").Delete
ActiveSheet.Cells(1, 1).Value = "lfd. Nummer des Kunden"
ActiveSheet.Cells(1, 2).Value = "Friseur"
ActiveSheet.Cells(1, 3).Value = "Anzahl"
ActiveSheet.Cells(1, 5).Value = "Kategorie"
ActiveSheet.Cells(1, 5).Value = "Produkt"
ActiveSheet.Cells(1, 6).Value = "Preis"
ActiveSheet.Columns("G:Z").Delete
ActiveSheet.Cells(Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row + 2, 5).Value = " _
Summe"
ActiveSheet.Cells(Sheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row, 6).Value = _
Application.WorksheetFunction.Sum(ActiveSheet.Range("F:F"))
ActiveSheet.Columns("A:F").EntireColumn.AutoFit
ActiveSheet.Columns("F").NumberFormat = "#,##0.00 "
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Activate()
Sheets("aktueller Kunde").Columns("A:H").Delete
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Fehler
ScreenUpdating = False
If Target.Column = 99 Then
Sheets("Übersicht").Rows("418:500").Delete
With ActiveSheet
.Range("CU6:CU405").SpecialCells(xlCellTypeConstants).Copy .Range("E418")
End With
End If
Exit Sub
ScreenUpdating = True
Fehler:
End Sub