Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Copy funktioniert nur einmal

Copy funktioniert nur einmal
03.10.2019 09:47:13
Toblerowner
Guten Tag
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

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Copy funktioniert nur einmal
03.10.2019 11:37:39
GerdL
Moin,
du kopierst 101 Zellen in einen Bereich mit 100 Zellen.
Sheets("Account").Range(Sheets("Account").Cells(5, Benutzer2), Sheets("Account").Cells(105, Benutzer2)).Copy Sheets("Quelle"). _
Range("A1:A101")
Versuche den Code ohne Fehlerunterdrückung zu schreiben.
Dim X As Range
Set X = Sheets("Account").Range("A4:Z4").Find(What:=Passwort1, LookIn:=xlValues)
If Not X Is Nothing Then Password2= X.Column
Gruß Gerd
AW: Copy funktioniert nur einmal
03.10.2019 11:40:57
ChrisL
Hi
In Ergänzung zu Gerd, hier ein alternativer Lösungsvorschlag.
Private Sub CommandButton1_Click()
With Worksheets("Account")
If TextBox1 = "" Then
MsgBox "kein Benutzer eingegeben"
Exit Sub
ElseIf TextBox2 = "" Then
MsgBox "kein PW eingegeben"
Exit Sub
ElseIf WorksheetFunction.CountIf(.Rows(3), TextBox1) = 0 Then
MsgBox "Benutzer nicht registriert"
Exit Sub
ElseIf .Cells(4, Application.Match(TextBox1, .Rows(3), 0))  TextBox2 Then
MsgBox "Passwort falsch"
Exit Sub
End If
MsgBox "alles OK, es darf kopiert werden"
End With
End Sub
cu
Chris
Anzeige
AW: Copy funktioniert nur einmal
03.10.2019 17:09:39
Toblerowner
Herzlichen Dank für die Hilfe!
Nun habe ich noch das Problem, dass es nur funktioniert, solange ich in der Arbeitsmappe "Account" bin. Sobald ich in einer anderen Arbeitsmappe bin, bekomme ich den Laufzeitfehler 1004, verstehe aber nicht warum?
Login:
Sheets("Quelle").Range("A1:A100").Value = Sheets("Account").Range(Cells(5, Benutzer2),  _
Cells(104, Benutzer2)).Value
UserForm2.Hide
UserForm1.Show
Exit Sub

AW: Copy funktioniert nur einmal
03.10.2019 17:18:13
ChrisL
Hi
Bitte, aber leider hast du die Antworten scheinbar nicht angenommen.
Dein Fehler sollte sich anhand des Hinweises von Gerd auflösen. Und wenn du meinen Ansatz nehmen würdest, bräuchte es kein Goto Login mehr.
https://de.wikipedia.org/wiki/Spaghetticode
Und da ich sowieso schon rum meckere, gleich noch folgender Hinweis :)
Datei = Mappe
Reiter = Blatt resp. Tabellenblatt
cu
Chris
Anzeige
AW: Copy funktioniert nur einmal
03.10.2019 18:42:14
ChrisL
Hi
Vielleicht so...
Private Sub CommandButton1_Click()
Dim Benutzer2 As Integer
With Worksheets("Account")
If TextBox1 = "" Then
MsgBox "kein Benutzer eingegeben"
Exit Sub
ElseIf TextBox2 = "" Then
MsgBox "kein PW eingegeben"
Exit Sub
ElseIf WorksheetFunction.CountIf(.Rows(3), TextBox1) = 0 Then
MsgBox "Benutzer nicht registriert"
Exit Sub
ElseIf .Cells(4, Application.Match(TextBox1, .Rows(3), 0))  TextBox2 Then
MsgBox "Passwort falsch"
Exit Sub
End If
Benutzer2 = Application.Match(TextBox1, .Rows(3), 0)
Sheets("Quelle").Range("A1:A100").Value = _
.Range(.Cells(5, Benutzer2), .Cells(104, Benutzer2)).Value
End With
End Sub

"Entleeren" (x=empty) empfiehlt sich übrigens bei Objekt-Variablen (z.B. Set x = Range). Hier nicht nötig.
cu
Chris
Anzeige
AW: Copy funktioniert nur einmal
04.10.2019 17:09:39
Werner
Hallo,
das liegt an der "unsauberen" Referenzierung auf das Blatt "Account".
Um korrekt zu Referenzieren muss vor jedem Range-Objekt (Range, Cells...) immer auch das entsprechende Tabellenblatt mit angegeben werden. Sonst ist wie bei deinem Code nur bei Range auf das Blatt "Account" referenziert, bei den beiden Cells aber auf das aktuell aktive Blatt.
Also bei deinem Code:
Login:
Sheets("Quelle").Range("A1:A100").Value = _
Sheets("Account").Range(Sheets("Account").Cells(5, Benutzer2), _
Sheets("Account").Cells(104, Benutzer2)).Value
UserForm2.Hide
UserForm1.Show
Exit Sub
Oder du benutzt, wie von ChrisL vorgeschlagen, eine With - End With. Dabei wird auf das im With angegebene Tabellenblatt referenziert, indem vor den Range-Objekten (Range, Cells...) ein Punkt gesetzt wird.
Gruß Werner
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige