Reihe einfügen nach Filtersuche
20.09.2013 17:19:11
Rosenwasser
Hallo,
Ich habe ein Formular wo mit ich die eingegebene oder Ausgewählte Daten nach ein anders Blatt (Project) Kopiere.
Was noch eingebaut werden muss ist wenn eine oder mehrere Reihen mit gleichen Projektnummer in Zeile B schon mal da ist, soll Excell hierunter eine neue Reihe hinzu fügen und die Daten Kopieren.
Wenn die Projektnummer noch nicht existiert sollen die neue Daten in eine leere Reihe am Ende den Daten Satz eingefügt werden.
Wer kann mir hiermit weiter helfen.
Meine Kode bis jetzt ist:
Private Sub Save_Click()
Dim lngWriteRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Project")
lngWriteRow = ws.Cells(Rows.Count, 2) _
.End(xlUp).Offset(1, 0).Row 'kijken naar laatst ingevulde lijn en volgende nemen
Dim oSht As Worksheet
Dim lastRow As Long, i As Long
Dim strSearch As String
Dim t As Long
Dim aCell As Range
t = GetTickCount
On Error GoTo Err
Set oSht = Sheets("Project")
lastRow = oSht.Range("B" & Rows.Count).End(xlUp).Row
strSearch = Projectnr.Value
Set aCell = oSht.Range("B1:B" & lastRow).Find(What:=strSearch, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
MsgBox "Value Found in Cell " & aCell.Address & vbCrLf & _
"and it took " & GetTickCount - t & "milliseconds"
End If
Err:
MsgBox "Item niet gevonden!"
If lngWriteRow Benny