VBA UserformEingabe in Blanco speichern und umbennen

[Coprat]

Hallo,

diesmal bin ich in Vorleistung gegangen. Ihr müsstet nur den Code etwas erweitern ;)

Ich packe für die Leute die keine Angst haben Makrodateien zu öffenen die Datei an.

Der Code lautet wie Folgt:   (ist mein erster selbstgeschriebener, Bitte nicht lynchen)

Code:

'Button:  Anlegen
Private Sub Anlegen_Click()
   

 Cells(6, 1) = Name_Kunde.Text
 Cells(6, 2) = BSW_Mixkiste.Text
 Cells(8, 1) = Palettenbelegung.Text
 Cells(14, 1) = Menge_Sorte1.Text
 Cells(15, 1) = Menge_Sorte2.Text
 Cells(16, 1) = Menge_Sorte3.Text
 Cells(17, 1) = Menge_Sorte4.Text
 Cells(14, 2) = Name_Sorte1.Text
 Cells(15, 2) = Name_Sorte2.Text
 Cells(16, 2) = Name_Sorte3.Text
 Cells(17, 2) = Name_Sorte4.Text
 Cells(14, 3) = BSW_Sorte1.Text
 Cells(15, 3) = BSW_Sorte2.Text
 Cells(16, 3) = BSW_Sorte3.Text
 Cells(17, 3) = BSW_Sorte4.Text
 
 Exit Sub
Fehler:  MsgBox "Eingabe Fehler aufgetreten"
End Sub
'Button:  Abbrechen
Private Sub Abbrechen_Click()
 Unload Me
End Sub

Der macht auch alles was ich will. Ich möchte jetzt nach den eintragungen, dass mit den Eingaben ein neuer Reiter entsteht der den Namen trägt der in A6 steht.

Der Button der die UF aufruft ist auf der Blanco Datei. Den möchte ich nacher auf einen Übersichtsreiter machen.

Ausserdem sollen alle mit der Userform erstellten Kunden, den Kundennamen und die BSW_Mixkiste auf einem Reiter Stammdaten aufgelistet werden

Ich hoffe ich konnte alles verständlich erklären

MFG

Sven

[Kuwer]

Hallo Sven,

z.B. so:

'Button:  Anlegen
Private Sub Anlegen_Click()
 Dim oWsKunde As Worksheet
 If Name_Kunde.Text <> "" Then
   On Error Resume Next
   Set oWsKunde = Worksheets(Name_Kunde.Text)
   On Error GoTo 0
   If oWsKunde Is Nothing Then
     Set oWsKunde = Worksheets.Add(After:=Worksheets(Worksheets.Count))
     oWsKunde.Name = Name_Kunde.Text
   End If
   With oWsKunde
     .Cells(6, 1) = Name_Kunde.Text
     .Cells(6, 2) = BSW_Mixkiste.Text
     .Cells(8, 1) = Palettenbelegung.Text
     .Cells(14, 1) = Menge_Sorte1.Text
     .Cells(15, 1) = Menge_Sorte2.Text
     .Cells(16, 1) = Menge_Sorte3.Text
     .Cells(17, 1) = Menge_Sorte4.Text
     .Cells(14, 2) = Name_Sorte1.Text
     .Cells(15, 2) = Name_Sorte2.Text
     .Cells(16, 2) = Name_Sorte3.Text
     .Cells(17, 2) = Name_Sorte4.Text
     .Cells(14, 3) = BSW_Sorte1.Text
     .Cells(15, 3) = BSW_Sorte2.Text
     .Cells(16, 3) = BSW_Sorte3.Text
     .Cells(17, 3) = BSW_Sorte4.Text
   End With
 End If
End Sub

Einen Reiter (Tabellenblatt) "Stammdaten" habe ich in Deiner Datei nicht gefunden.

Gruß Uwe

[Coprat]

Hallo Uwe,

Ich habe den Code jetz mal so eingefügt. Dabei kommt auch ein neues Tabellenblatt raus mit den EIngaben der Userform.
Aber diese sollen in dem Blanco Reiter eingetragen werden und dann mit dem neuen Namen abgelgt werden.

Der Reiter Stammdaten ist jetzt dabei ist aber nur ein leeres tabellenblatt.

Hba ich was falsch gemacht?

Gruß Sven

[Kuwer]

Aber diese sollen in dem Blanco Reiter eingetragen werden und dann mit dem neuen Namen abgelgt werden.

Sorry, hatte versehentlich die erste Version erwischt.

'Button:  Anlegen
Private Sub Anlegen_Click()
 Dim oWsKunde As Worksheet
 If Name_Kunde.Text <> "" Then
   On Error Resume Next
   Set oWsKunde = Worksheets(Name_Kunde.Text)
   If Not oWsKunde Is Nothing Then
     oWsKunde.Activate
   Else
     Application.DisplayAlerts = False
     Worksheets("blanco").Copy After:=Worksheets(Worksheets.Count)
     Application.DisplayAlerts = True
     Set oWsKunde = ActiveSheet
   End If
   With oWsKunde
     .Name = Name_Kunde.Text
     .Cells(6, 1) = Name_Kunde.Text
     .Cells(6, 2) = BSW_Mixkiste.Text
     .Cells(8, 1) = Palettenbelegung.Text
     .Cells(14, 1) = Menge_Sorte1.Text
     .Cells(15, 1) = Menge_Sorte2.Text
     .Cells(16, 1) = Menge_Sorte3.Text
     .Cells(17, 1) = Menge_Sorte4.Text
     .Cells(14, 2) = Name_Sorte1.Text
     .Cells(15, 2) = Name_Sorte2.Text
     .Cells(16, 2) = Name_Sorte3.Text
     .Cells(17, 2) = Name_Sorte4.Text
     .Cells(14, 3) = BSW_Sorte1.Text
     .Cells(15, 3) = BSW_Sorte2.Text
     .Cells(16, 3) = BSW_Sorte3.Text
     .Cells(17, 3) = BSW_Sorte4.Text
   End With
 End If
 On Error GoTo 0
End Sub

Der Reiter Stammdaten ist jetzt dabei ist aber nur ein leeres tabellenblatt.

Der war richtig gut.  :28:

Gruß Uwe

[Coprat]

Perfekt danke dir

Jetzt nur noch das die Zelle A8 auf dem Reiter Stammdaten B1 geschrieben wird und die Zelle B8 auf A1
der nächste kunde dann in B2 und A2 usw.

Gruß Sven

[Kuwer]

Jetzt nur noch das die Zelle A8 auf dem Reiter Stammdaten B1 geschrieben wird und die Zelle B8 auf A1
der nächste kunde dann in B2 und A2 usw.

Ein bisschen mehr Konzentration beim Verfassen der Beschreibung wäre schon wünschenswert.

Private Sub Anlegen_Click()
 Dim oWsKunde As Worksheet
 If Name_Kunde.Text <> "" Then
   On Error Resume Next
   Set oWsKunde = Worksheets(Name_Kunde.Text)
   If Not oWsKunde Is Nothing Then
     oWsKunde.Activate
   Else
     With Worksheets("Stammdaten").Cells(Rows.Count, 1).End(xlUp)
       .Offset(1, 0).Value = Name_Kunde.Text
       .Offset(1, 1).Value = BSW_Mixkiste.Text
     End With
     Application.DisplayAlerts = False
     Worksheets("blanco").Copy After:=Worksheets(Worksheets.Count)
     Application.DisplayAlerts = True
     Set oWsKunde = ActiveSheet
   End If
   With oWsKunde
     .Name = Name_Kunde.Text
     .Cells(6, 1) = Name_Kunde.Text
     .Cells(6, 2) = BSW_Mixkiste.Text
     .Cells(8, 1) = Palettenbelegung.Text
     .Cells(14, 1) = Menge_Sorte1.Text
     .Cells(15, 1) = Menge_Sorte2.Text
     .Cells(16, 1) = Menge_Sorte3.Text
     .Cells(17, 1) = Menge_Sorte4.Text
     .Cells(14, 2) = Name_Sorte1.Text
     .Cells(15, 2) = Name_Sorte2.Text
     .Cells(16, 2) = Name_Sorte3.Text
     .Cells(17, 2) = Name_Sorte4.Text
     .Cells(14, 3) = BSW_Sorte1.Text
     .Cells(15, 3) = BSW_Sorte2.Text
     .Cells(16, 3) = BSW_Sorte3.Text
     .Cells(17, 3) = BSW_Sorte4.Text
   End With
 End If
 On Error GoTo 0
End Sub

Gruß Uwe