hab mal wieder ein Porblem.Mit folgendem Code schreibe ich Daten durch eine UF in eine Ärzte Kartei. Funktioniert auchalles prima, jetzt ist mir aber aufgefallen, wenn z.B. eine Zelle leer bleibt, die z.B. email (Spalte G) und ich den nächsten Arzt eintragen will, bei dem ich die Email Eintragen kann, werden die Daten in die nächst freie Zelle geschrieben. Wie kann ich das ändern damit die Datensätze zusammen hängend geschrieben werden? Hat jemand ne Idee?
Gruß und Dank
Holger
Option Compare Text
Private Sub cmdQuit_Click()
Unload Me
End Sub
Private Sub cmdSave_Click()
Sheets("Ärzte").Select
On Error Resume Next
Application.ScreenUpdating = False
Dim Name As String
Name = Ärzte.TextBox1.Value
If Name = "" Then
GoTo Ende
Else
Call TextBox1_AfterUpdate
End If
Ende:
Sheets("Übersicht").Select
Range("A1").Select
Ärzte.ComboBox1.Value = ""
Ärzte.TextBox1.Value = ""
Ärzte.TextBox2.Value = ""
Ärzte.TextBox3.Value = ""
Ärzte.TextBox4.Value = ""
Ärzte.TextBox5.Value = ""
Ärzte.TextBox6.Value = ""
Application.ScreenUpdating = True
End Sub
Sub TextBox1_AfterUpdate()
Dim Fax As String
Dim Tele As String
Dim Name As String
Dim Vname As String
Dim Bez As String
Dim Anrede As String
Dim email As String
Name = Ärzte.TextBox1.Value
Tele = Ärzte.TextBox5.Value
Fax = Ärzte.TextBox3.Value
Bez = Ärzte.TextBox4.Value
Vname = Ärzte.TextBox2.Value
Anrede = Ärzte.ComboBox1.Value
email = Ärzte.TextBox6.Value
Dim Letzte As Long, zeile As Long
Dim s As String, t As String, a As String
Dim b As Integer, zeile1 As Integer
s = Ärzte.TextBox1.Value
t = Ärzte.TextBox2.Value
If Sheets("Ärzte").Range("A65536").Value = "" Then
Letzte = Sheets("Ärzte").Range("A65536").End(xlUp).Row
Else
Letzte = 65536
End If
For zeile = Letzte To 1 Step -1
If Sheets("Ärzte").Cells(zeile, 1).Value = Ärzte.TextBox1.Value Then
If Sheets("Ärzte").Cells(zeile, 2).Value = Ärzte.TextBox2.Value Then
MsgBox (" Arzt " & s & " ist schon vorhanden")
Ärzte.TextBox1.Value = ""
Ärzte.TextBox2.Value = ""
Ärzte.TextBox3.Value = ""
Ärzte.TextBox4.Value = ""
Ärzte.ComboBox1.Value = ""
Ärzte.TextBox5.Value = ""
Ärzte.TextBox6.Value = ""
Exit Sub
Else
a = 1
End If
Else
a = 1
End If
Next zeile
If a = 1 Then
Sheets("Ärzte").Range("A65536").End(xlUp).Offset(1, 0) = Name
Sheets("Ärzte").Range("B65536").End(xlUp).Offset(1, 0) = Vname
Sheets("Ärzte").Range("C65536").End(xlUp).Offset(1, 0) = Anrede
Sheets("Ärzte").Range("D65536").End(xlUp).Offset(1, 0) = Tele
Sheets("Ärzte").Range("E65536").End(xlUp).Offset(1, 0) = Fax
Sheets("Ärzte").Range("F65536").End(xlUp).Offset(1, 0) = Bez
Sheets("Ärzte").Range("G65536").End(xlUp).Offset(1, 0) = email
b = Sheets("Ärzte").Range("A65536").End(xlUp).Offset(0, 0).Row
For zeile1 = b To 1 Step -1
If Sheets("Ärzte").Cells(zeile1, 1).Value "" And Sheets("Ärzte").Cells(zeile1, 2).Value = "" Then
Sheets("Ärzte").Cells(zeile1, 1).EntireRow.Delete
End If
Next zeile1
End If
End Sub