[Excel] Mehrere Excel-Dateien mit ListView einlesen

[jagga007]

Hallo Leute,

In meiner Datei Check.xlsm habe ich es nun geschafft wie ich mit Listview drei Zellen aus allen Tabellen einlese, auch wenn die Inhalte doppelt vorkommen, sie aber in der ListView gefiltert nur einmal gelistet werden.

Mein Neues Problem ist nun eine Lösung zu finden, wie ich in der Datei Check.xlsm mit der vorhandenen ListView aus anderen Dateien die sich im gleichen Verzeichniss befinden in denen sich die identisch gleichen drei Zellen befinden genauso gefiltert "auch dazu" mit einlesen kann.

Meine aktuelle ListView sieht so aus.

Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
    With Me.ListView1
        .SortOrder = IIf(.SortOrder, 0, 1)
        .SortKey = ColumnHeader.SubItemIndex
        .Sorted = True
    End With
End Sub

Private Sub UserForm_Initialize()
Dim wks As Worksheet
Dim col As New Collection
Dim i

    '0:     Manuell
    '1:     Fenstermitte
    '2:     Bildschirmmitte
    '3:     Windows -Standard
    '    Me.StartUpPosition = 0
    '    Me.Top = 188
    '    Me.Left = 153

    With Me.ListView1
        .FullRowSelect = True
        .View = 3
        .LabelEdit = 1
        .Gridlines = True
        .HideSelection = False
        .AllowColumnReorder = False
        .ColumnHeaders.Add , , "Tabelle", 50
        .ColumnHeaders.Add , , "AuftragNr", 50
        .ColumnHeaders.Add , , "Firma", 200
        .ColumnHeaders.Add , , "Baustelle", 200

        For Each wks In ThisWorkbook.Worksheets

            If wks.Name <> "Namen" And wks.Name <> "Master" Then

                If wks.Range("B3") <> "" Or _
                   wks.Range("B4") <> "" Or _
                   wks.Range("B5") <> "" Then

                    On Error Resume Next
                    col.Add wks.Name, wks.Range("B3") & _
                                      wks.Range("B4") & _
                                      wks.Range("B5")
                    On Error GoTo 0
                End If
            End If

        Next wks

        For i = 1 To col.Count
            Set wks = ThisWorkbook.Worksheets(col(i))
            .ListItems.Add , , wks.Name
            .ListItems(.ListItems.Count).SubItems(1) = wks.Range("B3")
            .ListItems(.ListItems.Count).SubItems(2) = wks.Range("B4")
            .ListItems(.ListItems.Count).SubItems(3) = wks.Range("B5")
        Next i
    End With
    Set wks = Nothing
End Sub

Private Sub cmb_Eintragen_Click()
' überprüfen ob Auswahl getätigt
    If Me.ListView1.SelectedItem Is Nothing Then
        MsgBox "Kein Eintrag gewählt", vbOKOnly, "Info"
        Exit Sub
    Else
        appaF
        ActiveSheet.Range("B3") = Me.ListView1.SelectedItem.SubItems(1)
        ActiveSheet.Range("B4") = Me.ListView1.SelectedItem.SubItems(2)
        ActiveSheet.Range("B5") = Me.ListView1.SelectedItem.SubItems(3)
        appaT
        Unload Me
    End If
End Sub

Gibt es eine Möglichkeit sowas zu realisieren?

Für Infos wäre ich sehr Dankbar.

Gruß jagga007