unverständlicher Error

[elamigo]

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

[Der Steuerfuzzi]

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.

[elamigo]

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

[elamigo]

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".

[MisterBurns]

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...

[elamigo]

Thema kann pausiert werden.