gefilterte Tabelle Spalte makieren

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub test() Dim Re_Nr(), ArData, rng As Range Dim n&, nn& For Each rng In Tabelle1.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas ArData = rng.Columns(2).Resize(, 2) 'Spalte mit RE-Nr Angeben Redim Preserve Re_Nr(Ubound(ArData) + nn - 2) For n = 1 To Ubound(ArData) If nn > 0 Then Re_Nr(nn - 1) = ArData(n, 1) End If nn = nn + 1 Next n Next rng 'Ausgabe For n = Lbound(Re_Nr) To Ubound(Re_Nr) MsgBox Re_Nr(n) Next n End Sub

Sub test() Dim Re_Nr(), ArData, rng As Range Dim n&, nn& Dim obj As DataObject For Each rng In Tabelle1.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas ArData = rng.Columns(2).Resize(, 2) 'Spalte mit RE-Nr Angeben Redim Preserve Re_Nr(1 To Ubound(ArData) + nn) For n = 1 To Ubound(ArData) If nn > 0 Then Re_Nr(nn) = ArData(n, 1) End If nn = nn + 1 Next n Next rng 'Ausgabe Redim Preserve Re_Nr(1 To nn - 1) Set obj = New DataObject With obj .Clear .SetText Join(Re_Nr, vbCrLf) .PutInClipboard End With Set obj = Nothing End Sub

Hallo,
hier mal eine Variante.
Zuerst die Sub test starten damit die Re-Nr. in RE_Nr gelesen werden.
Danach kannst Du wenn Du im Excel bist mit der Tastenkombination Strg+Alt+c
die Einträge nacheinander in die Zwischenablage kopieren.
Mango für jeden nächsten Eintrag musst Du zu Excel zurückkehren und
die Tastenkombination ausführen.

Dim Re_Nr()

Sub test()
Dim ArData, rng As Range
Dim n&, nn&

For Each rng In Tabelle1.AutoFilter.Range.SpecialCells(xlCellTypeVisible).Areas
    ArData = rng.Columns(2).Resize(, 2) 'Spalte mit RE-Nr Angeben 
    Redim Preserve Re_Nr(1 To Ubound(ArData) + nn)
    For n = 1 To Ubound(ArData)
        If nn > 0 Then
            Re_Nr(nn) = ArData(n, 1)
        End If
        nn = nn + 1
    Next n
Next rng
Redim Preserve Re_Nr(1 To nn - 1)
Application.OnKey "^%c", "Einzel_RE_nach_ZW"
End Sub

Sub Einzel_RE_nach_ZW()
Static nIndex&
On Error GoTo ErrorHandler:
nIndex = nIndex + 1
If nIndex = 0 Or nIndex = Ubound(Re_Nr) Then
    nIndex = Lbound(Re_Nr)
End If

With New DataObject
    .Clear
    .SetText Re_Nr(nIndex)
    .PutInClipboard
End With
MsgBox "Aktueller Eintrag in Zwischenablage:" & vbCr & "Index: " & nIndex & vbCr & "Re-Nr.: " & Re_Nr(nIndex), vbInformation
Exit Sub

ErrorHandler:
nIndex = 0
Application.OnKey "^%c"
MsgBox "keine RE Nr. vorhanden!", vbCritical
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

gefilterte Tabelle Spalte makieren

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

gefilterte Tabelle Spalte makieren

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

299 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread