Clever-Excel-Forum

Guten Tag Leute,

ich habe eine Tabelle und möchte diese mit den Autofiltern filtern und dann per Tastenkombi die Userform aufrufen, allerdings kommt dann Laufzeitfehler 13, Typen unverträglich.
Besteht die Möglichkeit trotz gefilterter Tabelle eine Userform aufzurufen per Hotkeys
Hallo,

das deutet nicht auf einen Excel-Fehler hin, sondern auf einen VBA-Fehler. Dabei dürfte eine Variable verwendet werden oder einen Wert zugewiesen bekommen, der nicht ihrem Typ entspricht.

Da musst Du schon mindestens den Code, am besten die Datei herzeigen.
Code:
Private Sub ComboBox1_Change()

'Filtert Spalte N (=Spalte 14)

ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=14, Criteria1:=UserForm1.ComboBox1 '14 steht für die Spalte die gefiltert wird.

UserForm1.ComboBox2.Enabled = True 'aktiviert die 2 ComboBox

'ComboBox1.Sorted = True

Call Cbo_Spalte13 'ruft das Makro auf

End Sub

Private Sub ComboBox2_Change()

'Filtert Spalte M (=Spalte 13)

Criteria1 = UserForm1.ComboBox2 & "*"

ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=13, Criteria1:=UserForm1.ComboBox2 '13 steht für die Spalte die gefiltert wird.

UserForm1.ComboBox3.Enabled = True 'aktiviert die 3 ComboBox

Call Cbo_Spalte11 'ruft das Makro auf

End Sub

Private Sub ComboBox3_Change()

'Filtert Spalte L (=Spalte 12)

Criteria1 = UserForm1.ComboBox3 & "*"

ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=12, Criteria1:=UserForm1.ComboBox3 '11 steht für die Spalte die gefiltert wird.

End Sub

Private Sub Cbo_Spalte14()

Dim oDic14 As Object, meAr14

Dim A As Long

Set oDic14 = CreateObject("Scripting.Dictionary")

With Sheets("Tabelle1")

    meAr14 = .Range("N7", .Cells(.Rows.Count, "N").End(xlUp)).SpecialCells(xlCellTypeVisible)

End With

For A = 1 To UBound(meAr14)

  oDic14(meAr14(A, 1)) = 0

Next

ComboBox1.List = oDic14.keys

End Sub

Private Sub Cbo_Spalte13()

Dim ws As Worksheet

Dim iZeile As Long

Set ws = Sheets("Tabelle1")

For iZeile = 7 To ws.Cells(Rows.Count, "M").End(xlUp).Row

    If WorksheetFunction.CountIf(ws.Range("M7:M" & iZeile), ws.Cells(iZeile, "M")) = 1 And _

        ws.Rows(iZeile).Hidden = False Then _

    ComboBox2.AddItem ws.Cells(iZeile, "M")

Next iZeile

End Sub

Private Sub Cbo_Spalte11()

Dim ws As Worksheet

Dim iZeile As Long

Set ws = Sheets("Tabelle1")

For iZeile = 7 To ws.Cells(Rows.Count, "L").End(xlUp).Row

    If WorksheetFunction.CountIf(ws.Range("L7:L" & iZeile), ws.Cells(iZeile, "L")) = 1 And _

        ws.Rows(iZeile).Hidden = False Then _

    ComboBox3.AddItem ws.Cells(iZeile, "L")

Next iZeile

End Sub

Private Sub CommandButton10_Click()

With ActiveSheet

   .Range("b6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("b7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("b8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("b9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("b10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("b11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("b12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;"""";" & .Range("I1") & "!g7:g500;a1)"

   .Range("c6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("c7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("c8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("c9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("c10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("c11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("c12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;c13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;d13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;e13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;f13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;g13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;g13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;g13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;g13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;g13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;g13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h6").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a6;" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h7").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a7;" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h8").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a8;" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h9").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a9;" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h10").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a10;" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h11").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;a11;" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h12").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!z7:z500;"""";" & .Range("I1") & "!aa7:aa500;h13;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d34").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;d33;" & .Range("I1") & "!Ac7:ac500;c34;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d35").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;d33;" & .Range("I1") & "!ac7:ac500;c35;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d36").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;d33;" & .Range("I1") & "!ac7:ac500;c36;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d37").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;d33;" & .Range("I1") & "!ac7:ac500;c37;" & .Range("I1") & "!g7:g500;a1)"

   .Range("d38").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;d33;" & .Range("I1") & "!ac7:ac500;c38;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e34").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;e33;" & .Range("I1") & "!ac7:ac500;c34;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e35").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;e33;" & .Range("I1") & "!ac7:ac500;c35;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e36").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;e33;" & .Range("I1") & "!ac7:ac500;c36;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e37").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;e33;" & .Range("I1") & "!ac7:ac500;c37;" & .Range("I1") & "!g7:g500;a1)"

   .Range("e38").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;e33;" & .Range("I1") & "!ac7:ac500;c38;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f34").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;f33;" & .Range("I1") & "!ac7:ac500;c34;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f35").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;f33;" & .Range("I1") & "!ac7:ac500;c35;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f36").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;f33;" & .Range("I1") & "!ac7:ac500;c36;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f37").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;f33;" & .Range("I1") & "!ac7:ac500;c37;" & .Range("I1") & "!g7:g500;a1)"

   .Range("f38").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;f33;" & .Range("I1") & "!ac7:ac500;c38;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g34").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;g33;" & .Range("I1") & "!ac7:ac500;c34;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g35").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;g33;" & .Range("I1") & "!ac7:ac500;c35;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g36").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;g33;" & .Range("I1") & "!ac7:ac500;c36;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g37").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;g33;" & .Range("I1") & "!ac7:ac500;c37;" & .Range("I1") & "!g7:g500;a1)"

   .Range("g38").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;g33;" & .Range("I1") & "!ac7:ac500;c38;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h34").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;h33;" & .Range("I1") & "!ac7:ac500;c34;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h35").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;h33;" & .Range("I1") & "!ac7:ac500;c35;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h36").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;h33;" & .Range("I1") & "!ac7:ac500;c36;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h37").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;h33;" & .Range("I1") & "!ac7:ac500;c37;" & .Range("I1") & "!g7:g500;a1)"

   .Range("h38").FormulaLocal = "=ZÄHLENWENNS(" & .Range("I1") & "!ab7:ab500;h33;" & .Range("I1") & "!ac7:ac500;c38;" & .Range("I1") & "!g7:g500;a1)"

   Call UserForm_Activate

End With

End Sub

Private Sub CommandButton11_Click()

    ActiveSheet.Select

    ActiveSheet.Name = TextBoxDiagramm.Text

    Call UserForm_Activate

End Sub

Private Sub CommandButton12_Click()

On Error Resume Next

With Me.ComboBox1

For x = LBound(.List) To UBound(.List)

For y = x To UBound(.List)

    If .List(y, 0) < .List(x, 0) Then

          blah = .List(y, 0)

         .List(y, 0) = .List(x, 0)

         .List(x, 0) = blah

    End If

    Next y

Next x

End With

End Sub

Private Sub CommandButton13_Click()

On Error Resume Next

With Me.ComboBox2

For x = LBound(.List) To UBound(.List)

For y = x To UBound(.List)

    If .List(y, 0) < .List(x, 0) Then

          blahh = .List(y, 0)

         .List(y, 0) = .List(x, 0)

         .List(x, 0) = blahh

    End If

    Next y

Next x

End With

End Sub

Private Sub CommandButton14_Click()

On Error Resume Next

With Me.ComboBox3

For x = LBound(.List) To UBound(.List)

For y = x To UBound(.List)

    If .List(y, 0) < .List(x, 0) Then

          blahhh = .List(y, 0)

         .List(y, 0) = .List(x, 0)

         .List(x, 0) = blahhh

    End If

    Next y

Next x

End With

End Sub

Private Sub CommandButton15_Click()

Columns("a:d").Select

Selection.ColumnWidth = 10

Columns("e:e").Select

Selection.ColumnWidth = 12

Columns("f:f").Select

Selection.ColumnWidth = 18

Columns("G:h").Select

Selection.ColumnWidth = 14

Columns("i:i").Select

Selection.ColumnWidth = 10

Columns("j:k").Select

Selection.ColumnWidth = 13

Columns("l:n").Select

Selection.ColumnWidth = 10

Columns("o:o").Select

Selection.ColumnWidth = 16

Columns("p:p").Select

Selection.ColumnWidth = 10

Columns("q:q").Select

Selection.ColumnWidth = 25

Columns("r:t").Select

Selection.ColumnWidth = 18

Columns("u:u").Select

Selection.ColumnWidth = 40

Columns("v:x").Select

Selection.ColumnWidth = 13

Columns("y:aa").Select

Selection.ColumnWidth = 13

Columns("ab:ad").Select

Selection.ColumnWidth = 10

Columns("ae:ae").Select

Selection.ColumnWidth = 22

End Sub

Private Sub CommandButton8_Click()

Dim Indx As Integer, Zahl As Integer

Sheets("Diagramm").Copy After:=ActiveSheet

Indx = ActiveSheet.Index

Zahl = ThisWorkbook.Worksheets.Count

'nur Linkes oder Rechts Blatt dann so!

If Indx > 1 Then

ActiveSheet.Range("I1").Value = Worksheets(Indx - 1).Name

End If

End Sub

Private Sub TextBox1_Change()

Text = ""

End Sub

Private Sub TextBoxDiagramm_Change()

Text = ""

End Sub

Private Sub UserForm_Initialize()

Call Cbo_Spalte14

UserForm1.ComboBox2.Enabled = False

UserForm1.ComboBox3.Enabled = False

End Sub

Private Sub CommandButton1_Click()

' kopieren in neues Tabellenblatt

ActiveSheet.Range("A1:AE" & ActiveSheet.UsedRange.Rows.Count). _

    SpecialCells(xlCellTypeVisible).Copy

Sheets.Add After:=ActiveSheet

Range("A1").Select

ActiveSheet.Paste

End Sub

Private Sub CommandButton2_Click()

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim Sourcewb As Workbook

    Dim Destwb As Workbook

    Dim TempFilePath As String

    Dim TempFileName As String

    Dim OutApp As Object

    Dim OutMail As Object

    Dim lngSheet As Long

    Dim lngTMP As Long

    Dim varArrSheets() As Variant

    On Error GoTo Fin

    If ListBox1.ListCount = 0 Then

        MsgBox "Es wurden keine Tabellenblätter gewählt.", vbOKOnly + vbExclamation, "Warnung"

        Exit Sub

    Else

        For lngTMP = 0 To ListBox1.ListCount - 1

            If ListBox1.Selected(lngTMP) Then

                ReDim Preserve varArrSheets(lngSheet)

                varArrSheets(lngSheet) = ListBox1.List(lngTMP)

                lngSheet = lngSheet + 1

            End If

        Next lngTMP

    End If

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

        .DisplayAlerts = False

    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the ActiveSheet to a new workbook

    'ActiveSheet.Copy

    ThisWorkbook.Worksheets(varArrSheets).Copy

    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format

    With Destwb

           If Val(Application.Version) < 12 Then

            'You use Excel 97-2003

            FileExtStr = ".xls": FileFormatNum = -4143

        Else

            'You use Excel 2007-2016

            Select Case Sourcewb.FileFormat

            Case 51: FileExtStr = ".xlsx": FileFormatNum = 51

            Case 52:

                If .HasVBProject Then

                    FileExtStr = ".xlsm": FileFormatNum = 52

                Else

                    FileExtStr = ".xlsx": FileFormatNum = 51

                End If

            Case 56: FileExtStr = ".xls": FileFormatNum = 56

            Case Else: FileExtStr = ".xlsb": FileFormatNum = 50

            End Select

        End If

    End With

    'Save the new workbook/Mail it/Delete it

    ' Pfad anpassen - abschliessenden Backslash nicht vergessen!!!

    TempFilePath = Environ$("temp") & "\"

    TempFileName = TextBoxDatei.Text

    Set OutApp = CreateObject("Outlook.Application")

    Set OutMail = OutApp.CreateItemFromTemplate("\")

    With Destwb

        .SaveAs "\\\" & TempFileName & FileExtStr, FileFormat:=FileFormatNum, Password:="MAG2019", ReadOnlyRecommended:=False, CreateBackup:=False

        On Error Resume Next

        With OutMail

            .To = ""

            .CC = ""

            .BCC = ""

            '.Subject = ""

            '.Body = ""

            .Attachments.Add Destwb.FullName

            'Anhang hinzufügen

            .Attachments.Add ("")

            '.Send or use

            .Display

        End With

        On Error GoTo 0

        .Close savechanges:=False

    End With

    'Delete the file you have send

    'Kill TempFilePath & TempFileName & FileExtStr

Fin:

    Set OutMail = Nothing

    Set OutApp = Nothing

    With Application

        .ScreenUpdating = True

        .EnableEvents = True

        .DisplayAlerts = True

    End With

    Unload UserForm1

End Sub

Private Sub CommandButton3_Click()

 ' Filterzrücksetzen Makro

ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=12

ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=13

ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=14

        Unload UserForm1

        UserForm1.Show

End Sub

Private Sub CommandButton4_Click()

    ActiveSheet.Select

    ActiveSheet.Name = TextBoxTabellenblatt.Text

    Call UserForm_Activate

End Sub

Private Sub CommandButton5_Click()

 'Fenster schließen

Unload UserForm1

 End Sub

Private Sub TextBoxTabellenblatt_Change()

Text = ""

End Sub

Private Sub UserForm_Activate()

    Dim lngTMP As Long

    Dim strSheets() As String

    ReDim strSheets(1 To Worksheets.Count)

    For lngTMP = 1 To Sheets.Count

        strSheets(lngTMP) = Worksheets(lngTMP).Name

    Next

    ListBox1.List = strSheets

    ListBox1.MultiSelect = fmMultiSelectMulti

End Sub
Das komische ist ja das ich eine Spalte filtern kann und der Hotkey dann funktioniert. Aber nur gewisse Spalten. Habe auch gar keine Ahnung wo ich nachschauen soll welche Spalte er "akzeptiert".
Du erwartest jetzt nicht ernsthaft, dass jemand diesen elendslangen Code nach einem Fehler durchsucht?
Einzelschrittmodus? Welche Zeile produziert den Fehler?

Bei so vielen Beiträgen solltest du da eigentlich bereits wissen...
Thema kann pausiert werden.
elamigo

Der Steuerfuzzi

elamigo

elamigo

MisterBurns

elamigo
