auf aktives Tabellenblatt umstellen
03.08.2006 11:56:08
Wolfgang
irgendwie komme ich nicht weiter. Mit untenstehendem Code möchte ich erreichen, dass in einer UF die Textfelder aus einem Tabellenblatt "Daten" gefüllt werden. Das gelingt auch soweit. Über CmdÜbernehmen soll erreicht werden, dass der Inhalt der Textfelder nun in das jeweils aktive Tabellenblatt eingetragen wird. Ich bekomme es leider nicht hin. Die Daten werden jetzt immer in das Tabellenblatt "Daten" eingetragen. Kann mir da vielleicht jemand weiterhelfen? -Schon jetzt Danke für die Rückmeldungen.
Herzliche Grüße
Wolfgang
Private Sub UserForm_Activate()
Textfelder_Fuellen
End Sub
Sub Textfelder_Fuellen()
With Sheets("Daten").Activate
' Spaltenformat soll überall Standard sein
Cells.Select
Selection.NumberFormat = "General"
Columns("DD:DD").Select
Selection.NumberFormat = "m/d/yyyy"
'Anrede + ggfs. Titel CX2 und CY2
txtAnrede.Text = Range("CX2").Text & Space(1) & Range("CY2").Text
'Name + ggfs. Namenszusatz DB2 und DA2
If Range("DA2").Text = "" Then
txtName.Text = Range("DB2").Text & Space(1) & Range("DA2").Text
Else
txtName.Text = Range("DB2").Text & "," & Space(1) & Range("DA2").Text
End If
'Vorname CZ2
txtVorname.Text = Range("CZ2").Text
'Kundennummer FG2
txtKDnr.Text = Range("FG2").Text
End With
End Sub
Private Sub cmdÜbernehmen_Click()
Dim lngAnz As Long
Dim objtbl As Object
Dim strLinkAdresse As String
Dim strRange As String
If txtName <> "" Then
'Neuen Eintrag in Liste einfügen
Range("A2").Select
Set objtbl = ActiveCell.CurrentRegion
'Anzahl der Zeilen der Tabelle ermitteln
lngAnz = objtbl.Rows.Count - CON_ANZAHL_HEADER_OFFSET
'Name
Range("A2").Offset(lngAnz + 1).Value = txtName
'Vorname
Range("B2").Offset(lngAnz + 1).Value = txtVorname
'Kundennummer
Range("I2").Offset(lngAnz + 1).Value = txtKdnr
'Anrede
Range("L2").Offset(lngAnz + 1).Value = txtAnrede
'sortieren
strRange = "A2:U" + Trim$(Str$(lngAnz + 2 + CON_ANZAHL_HEADER_OFFSET))
Range(strRange).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Unload Me
Else
MsgBox "Textfeld Name,Vorname darf nicht leer sein." & Chr$(10) & "Eintrag wird nicht übernommen.", vbInformation
txtName.SetFocus
End If
End Sub