10.03.2021, 15:02
(Dieser Beitrag wurde zuletzt bearbeitet: 10.03.2021, 15:03 von Steffl.
Bearbeitungsgrund: Tippfehler berichtigt.
)
Hallo Frank,
wie bereits Uwe schon geschrieben hat: Mit Option Compare Text geht es. Und wie von mir erwähnt, das gehört oben hin. Also vor deinem Listbox1_Click-Ereignis.
wie bereits Uwe schon geschrieben hat: Mit Option Compare Text geht es. Und wie von mir erwähnt, das gehört oben hin. Also vor deinem Listbox1_Click-Ereignis.
Code:
Option Compare Text
Private Sub ListBox1_Click()
ListBox1.ListFillRange = "Suche"
End Sub
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
If Tabelle1.Range("H5").Value = 0 Then
MsgBox "Sie müssen einen Vertrag auswählen !", , "Fehlermeldung"
End If
If Not Tabelle1.Range("H5").Value = 0 Then
'Datensatz aus Archiv holen und ins Suchergebnis eintragen
Dim i As Long, tLR As Long
Dim ZielWks As Worksheet, QuelleWks As Worksheet
Set QuelleWks = Worksheets("Firmenverträge")
Set ZielWks = Worksheets("Suchergebnis_Firmenverträge")
Range("H5").Copy
Range("H6").PasteSpecial xlPasteValues
Application.CutCopyMode = False
Range("A1").Select
Worksheets("Suchergebnis_Firmenverträge").Rows("2:" & Worksheets("Suchergebnis_Firmenverträge").Rows.Count).ClearContents
With QuelleWks
For i = 1 To .Cells(.Rows.Count, 11).End(xlUp).Row
If .Cells(i, 1).Value = (Tabelle1.Range("H6").Value) Then
tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
Debug.Print tLR
With ZielWks
.Range(.Cells(tLR, 1), .Cells(tLR, 23)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 23)).Value
QuelleWks.Rows(i).Delete
End With
End If
Next i
End With
SucheVertrag = ""
frmFirmenvertrag_3.Show
End If
End Sub
Private Sub SucheVertrag_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim i As Long, tLR As Long
Dim ZielWks As Worksheet, QuelleWks As Worksheet
Set QuelleWks = Worksheets("Firmenverträge")
Set ZielWks = Worksheets("Suchergebnis_Firmenverträge")
Worksheets("Suchergebnis_Firmenverträge").Rows("2:" & Worksheets("Suchergebnis_Firmenverträge").Rows.Count).ClearContents
With QuelleWks
For i = 2 To .Cells(.Rows.Count, 23).End(xlUp).Row
If .Cells(i, 3).Value Like SucheVertrag & "*" Then
tLR = ZielWks.Cells(Rows.Count, 1).End(xlUp).Row + 1
Debug.Print tLR
With ZielWks
.Range(.Cells(tLR, 1), .Cells(tLR, 7)).Value = QuelleWks.Range(QuelleWks.Cells(i, 1), _
QuelleWks.Cells(i, 7)).Value
End With
End If
Next i
End With
End Sub
Gruß Stefan
Win 10 / Office 2016
Win 10 / Office 2016