Copy funktioniert nur einmal
03.10.2019 09:47:13
Toblerowner
Ich habe keine Grundbasis was VBA anbelangt, habe mir aber angefangen etwas zusammenzubasteln. Mein Code ist deswegen auch nicht sehr elegant...
Man soll sich über die Userform2 mit Benutzername und Passwort einloggen. Ist der Benutzer in der Mappe "Account" in der Reihe 3 vorhanden und stimmt mit dem Passwort aus Reihe 2 überein, sollen die darunterliegenden Zellen kopiert und in der Mappe "Quelle" eingefügt werden. Das funktioniert auch, aber nur einmal! Anschliessend muss ich die Arbeitsmappe erneut öffnen, da er ansonsten den Kopiervorgang nicht wiederholt. Wie man sieht habe ich (erfolglos) versucht mein Problem mit leeren der Variablen und des Zwischenspeichers zu lösen.
Private Sub CommandButton1_Click()
Sheets("Account").Cells(1, 2).Value = LoginBenutzername.Text
Sheets("Account").Cells(1, 3).Value = LoginPasswort.Text
Benutzer1 = Sheets("Account").Range("B1")
If Benutzer1 = 0 Then
MsgBox "Bitte Benutzernamen eingeben"
Exit Sub
End If
On Error Resume Next
Benutzer2 = Sheets("Account").Range("A3:Z3").Find(What:=Benutzer1, LookIn:=xlValues).Column
'MsgBox "Benutzer bei:" & Benutzer2
If Benutzer2 > 0 Then
Resume
Else
MsgBox "Benutzername und/oder Passwort falsch"
Exit Sub
End If
Passwort1 = Sheets("Account").Range("C1")
If Passwort1 = 0 Then
MsgBox "Bitte Passwort eingeben"
Exit Sub
End If
On Error Resume Next
Passwort2 = Sheets("Account").Range("A4:Z4").Find(What:=Passwort1, LookIn:=xlValues).Column
'MsgBox "Passwort bei:" & Passwort2
If Passwort2 > 0 Then
Resume
Else
MsgBox "Benutzername und/oder Passwort falsch"
Exit Sub
End If
If Benutzer2 = Passwort2 Then
GoTo Login
Else
MsgBox "Benutzername und/oder Passwort falsch"
Exit Sub
End If
Login:
'MsgBox "LOGIN!!!"
'Sheets("Quelle").Range("A1:A100").Clear
MsgBox Benutzer2
Sheets("Account").Range(Cells(5, Benutzer2), Cells(105, Benutzer2)).Copy Sheets("Quelle"). _
_
Range("A1:A100")
Application.CutCopyMode = False
Benutzer1 = Empty
Benutzer2 = Empty
Password1 = Empty
Password2 = Empty
UserForm2.Hide
UserForm1.Show
End Sub