Userform
26.11.2007 13:53:00
lisa
Ich bräuchte noch einmal eure Hilfe
Bei meinem beigefügten Code habe ich eine UserForm eingfügt über diese ich eine Eingabe machen will.
Die UserForm funktioniert soweit.
Im Moment kann ich die Daten mit der UserForm nur in die Celle J1 der Tabelle2 übergeben.
Nun kommte auch schon meine Frage:
Über den Code übergebe ich einen Datensatz an die Tabelle2 fortlaufend! (wenn ich die Altdaten nicht lösche)
Zu diesem Datensatz soll nun auch immer in spalte J die eingabe aus der UserForm übernommen werden.
Kann mir hier jemand dahingehend den Code umstellen?
Danke für die Bemühungen!
Gruß Lisa
Private Sub CommandButton2_Click()
Dim wksZiel As Worksheet, wksData As Worksheet
Dim lRow As Long, lZeile As Long, lTest As Long, start As Long
Dim fFilter As Filter, bFilterAktiv As Boolean
Set wksData = Worksheets("Datenbank")
Set wksZiel = Worksheets("Tabelle2")
With wksData
If .AutoFilterMode = True Then
For Each fFilter In .AutoFilter.Filters
If fFilter.On Then bFilterAktiv = True: Exit For
Next
Else
bFilterAktiv = False
End If
If Not bFilterAktiv Then
MsgBox "Kein Autofilter aktiv!", vbOKOnly + vbExclamation, "kopieren"
GoTo beenden
End If
lTest = MsgBox("Altdaten in Zieltabelle löschen?", vbQuestion + vbYesNoCancel, _
"Ausschneiden, verschieben")
If lTest = vbYes Then
lRow = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row
If lRow >= 2 Then
wksZiel.Range(wksZiel.Cells(2, 1), wksZiel.Cells(lRow, 9)).ClearContents
End If
ElseIf lTest = vbCancel Then
GoTo beenden
End If
Application.EnableEvents = False
Application.ScreenUpdating = False
lRow = wksZiel.Cells(wksZiel.Rows.Count, 1).End(xlUp).Row + 1
lTest = .Cells(.Rows.Count, 1).End(xlUp).Row
For lZeile = 3 To lTest
If .Rows(lZeile).Hidden = False Then
.Range("A" & lZeile, "I" & lZeile).Cut Destination:=wksZiel.Cells(lRow, 1)
Exit For
End If
Next
Application.CutCopyMode = False
If .Cells.SpecialCells(xlCellTypeVisible).Count .Cells.Count Then
.ShowAllData
For lZeile = lTest To 3 Step -1
If IsEmpty(.Cells(lZeile, 1)) Then
start = lZeile
Do Until Not IsEmpty(.Cells(lZeile, 1))
lZeile = lZeile - 1
Loop
.Range(.Rows(lZeile + 1), .Rows(start)).Delete shift:=xlShiftUp
End If
Next
End If
Application.ScreenUpdating = True
Application.EnableEvents = True
.Range("a1").Select
Selection.ClearContents
MsgBox "Gefilterte Daten wurden nach " & wksZiel.Name & " kopiert!", _
vbOKOnly + vbInformation, "ausschneiden und verschieben"
End With
With wksZiel
.Activate
End With
beenden:
Set wksZiel = Nothing: Set wksData = Nothing: Set fFilter = Nothing
NamenForm.FunktionCombo.Clear
NamenForm.NameBox.Text = ""
For i = 0 To 3
NamenForm.FunktionCombo.AddItem (ActiveSheet.[Funktionen].Cells.Offset(i, 0))
Next i
NamenForm.Show
End Sub