Liste aus Liste generieren Auswahlmöglichkeit

Hallo zusammen
ich habe folgendes Problem: ich sollte aus einer bestehenden Liste eine neue Liste generieren.
Dabei habe ich Kontrollköstchen, welche ich anklicken kann. Somit kann ich die neu zu überführenden Werte auswählen. Aufgrund dessen kann ich dann auch eine Wahr/ Falsch Aussage für die Sortierung machen.
Ein Beispiel liegt unter:
https://www.herber.de/bbs/user/72333.xls
Die Spalten Produkt, Hersteller und Material sind in einer Sammelliste hinterlegt. jetzt gibt es unterschiedliche Kunden und jeder der Kunden kann sich seine Sachen auswählen (durch Makrierung im Kontrollkästchen. Links neben den Häckchen habe ich jeweils wahr oder falsch für die Kontrollköstchen.
Ich möchte nun, dass ich auf das jeweilig Buttom überhalb des Kunden Klicke und ich dann eine separate Mappe mit nur den ausgeählten Produkten erhalte.
Kann mir da jemand helfen?!?
Besten Dank

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo,
meinst Du so?

Option Explicit

Sub ListeGenerieren()
Dim ArrayListe(), ArrayErgebnis(), ArrayNewListe()
Dim lngIndex As Long, nC As Long

With Tabelle1
    If IsError(Application.Caller) Then Exit Sub 'kein Button gedrückt 
    lngIndex = .Shapes(Application.Caller).TopLeftCell.Column 'Spalte wo Button liegt 
    With .Range("A4", .Cells(.Rows.Count, 1).End(xlUp))
        ArrayListe = .Resize(, 3) 'Liste 
        ArrayErgebnis = .Offset(0, 4 + lngIndex) 'Ergebnis 
        Redim Preserve ArrayNewListe(1 To 3, 1 To Ubound(ArrayListe)) 'neues leeres Array 
    End With
End With
'Überschrift 
ArrayNewListe(1, 1) = ArrayListe(1, 1)
ArrayNewListe(2, 1) = ArrayListe(1, 2)
ArrayNewListe(3, 1) = ArrayListe(1, 3)
nC = 1 '1 wegen Überschrift 
For lngIndex = 2 To Ubound(ArrayListe)
    If ArrayErgebnis(lngIndex, 1) Then
        nC = nC + 1
        ArrayNewListe(1, nC) = ArrayListe(lngIndex, 1)
        ArrayNewListe(2, nC) = ArrayListe(lngIndex, 2)
        ArrayNewListe(3, nC) = ArrayListe(lngIndex, 3)
    End If
Next lngIndex

If nC > 1 Then 'waren Ergebisse auf Wahr 
    Redim Preserve ArrayNewListe(1 To 3, 1 To nC)
    ArrayNewListe = Application.Transpose(ArrayNewListe) 'Array drehen 
    With Workbooks.Add(1) 'neue Mappe erstellen 
        With .Sheets(1) 'erste Tabelle 
            With .Range("A1", Cells(Ubound(ArrayNewListe), 1).Resize(, 3)) 'Rangebereich 
                .Value = ArrayNewListe 'Daten schreiben 
                .Rows(1).Font.Bold = True 'Überschrift fett 
                .EntireColumn.AutoFit 'optimale Spaltenbreite 
            End With
        End With
    End With
End If

End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Liste aus Liste generieren Auswahlmöglichkeit

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Liste aus Liste generieren Auswahlmöglichkeit

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

313 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread