Clever-Excel-Forum

Seiten: 1 2

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.

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

Super, das klappt perfekt !!

Kannst du mir noch sagen wie ich es schaffe das sich die Listbox beim schließen leert?

Gruß Frank

Hallo Frank,

ich gehe davon aus, dass Du den Schließenbutton auf dem Tabellenblatt Start meinst (der Code dazu befindet sich im Modul1

Code:
Sub Schliessen()

Tabelle1.ListBox1.ListFillRange = ""

Range("A1").Select

ActiveWorkbook.Save

ActiveWorkbook.Close

End Sub

und noch ganz wichtig eine Änderung im Code Workbook_Open im Klassenmodul DieseArbeitsmappe

Code:
Private Sub Workbook_Open()

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

'folgende Codezeile wurde eingefügt

Tabelle1.ListBox1.ListFillRange = "Suche"

With QuelleWks

    For i = 2 To .Cells(.Rows.Count, 23).End(xlUp).Row

        'If .Cells(i, 5).Value = "offen" 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

            End With

        'End If

    Next i

End With

Worksheets("Start").Activate

Range("H5").Value = 0

Range("A1").Select

End Sub

Seiten: 1 2

Steffl

FrankyHB

Steffl