Makro erst nach Filter
15.04.2013 13:14:40
Thms
ich habe unten stehenden Code, den ich nach Verwendung eines Filter verwende.
Mein Problem: Wenn man den Button klickt, der das Makro ausführt, bevor man einen Filter gesetzt hat, funktioniert es nicht mehr.
Meine Frage: Kann ich es irgendwie einstellen, dass man den Makro-Button erst klicken kann, nachdem in der Tabelle ein Filter gesetzt wurde?
Oder ist da ein Fehler im Code, so dass mein beschriebenes Problem behoben werden könnte, wenn man da was ändert?
Bin leider wirklich total unwissend was das Ganze angeht.
Beste Grüße
Thomas
Code:
Sub Schritt_1_Filterergebnisse_in_Ergbnisstabelle_kopieren()
Dim i As Long, j As Long, k As Long
Dim lngLetzte As Long
Dim rngA As Range
Dim wks As Worksheet
Set wks = Sheets("Ergebnisse")
j = 2
With wks
lngLetzte = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:C" & lngLetzte).ClearContents
.Range("A2:C" & lngLetzte).EntireRow.RowHeight = 54
End With
With ActiveSheet
If .AutoFilterMode Then
If .FilterMode Then
For i = 2 To .AutoFilter.Range.Rows.Count
If Rows(i).Hidden = False Then
If .Cells(i, 2).MergeCells = True Then
k = .Cells(i, 2).MergeArea.Row
wks.Cells(j, 1) = .Cells(k, 1)
wks.Cells(j, 2) = .Cells(k, 2)
wks.Cells(j, 3) = .Cells(k, 3)
wks.Cells(j, 4) = .Cells(k, 4)
wks.Cells(j, 5) = .Cells(k, 5)
wks.Cells(j, 6) = .Cells(k, 6)
wks.Cells(j, 7) = .Cells(k, 7)
wks.Cells(j, 8) = .Cells(k, 8)
wks.Cells(j, 9) = .Cells(k, 9)
wks.Cells(j, 10) = .Cells(k, 10)
wks.Cells(j, 11) = .Cells(k, 11)
wks.Cells(j, 12) = .Cells(k, 12)
wks.Cells(j, 12) = .Cells(k, 13)
wks.Cells(j, 12) = .Cells(k, 14)
wks.Cells(j, 12) = .Cells(k, 15)
wks.Cells(j, 12) = .Cells(k, 16)
wks.Cells(j, 12) = .Cells(k, 17)
wks.Cells(j, 10) = .Cells(k, 18)
wks.Cells(j, 11) = .Cells(k, 19)
wks.Cells(j, 12) = .Cells(k, 20)
wks.Cells(j, 12) = .Cells(k, 21)
wks.Cells(j, 12) = .Cells(k, 22)
wks.Cells(j, 12) = .Cells(k, 23)
wks.Cells(j, 12) = .Cells(k, 24)
wks.Cells(j, 12) = .Cells(k, 25)
wks.Rows(j).RowHeight = 300
j = j + 1
Else
wks.Range(wks.Cells(j, 1), wks.Cells(j, 3)) = .Range(.Cells(i, 1), .Cells( _
i, 3)).Value
j = j + 1
End If
End If
Next i
.ShowAllData
End If
End If
End With
Sheets("Ergebnisse").Select
End Sub