AW: Autofilterprozedure endet in Fehlermeldung.
25.09.2014 16:56:23
fcs
Hallo Peter,
du hast ja jetzt schon etliche Methoden zur Bestimmung der nächsten freien Zeile kennengelernt und auch deren unerwünschten Ergebnise.
Es gibt neben den beiden von dir schon mehr oder weniger erfolgreich angewendeten noch 2 andere gängige Methoden zur Bestimmung der letzten benutzten Zeile bzw. der nächsten freien Zeile. Welche geeignet ist bzw. verwendet werden muss hängt z.T. von den Daten in der Tabelle ab.
Dein Problem mit dem letzten Makro ist wahrschscheinlich, dass du Select auf ein Objekt versuchst, das nicht auf dem aktiveb Blatt ist.
Nachfolgenden die Makros/Functions.
Gruß
Franz
Sub aaTest()'Testmakro zur berechnung der letzten Zeile mit Daten
Dim lngZeileN As Long
lngZeileN = fncZeileNaechste1(Spalte:=2)
MsgBox lngZeileN, , "fncZeileNaechste1"
lngZeileN = fncZeileNaechste2
MsgBox lngZeileN, , "fncZeileNaechste2"
lngZeileN = fncZeileNaechste3
MsgBox lngZeileN, , "fncZeileNaechste3"
lngZeileN = fncZeileNaechste4
MsgBox lngZeileN, , "fncZeileNaechste4"
End Sub
Sub MinCopy()
Dim ZeileN As Long
ZeileN = fncZeileNaechste3(wks:=Worksheets("fake"))
ActiveSheet.AutoFilter.Range.Offset(1, 0).Copy _
Worksheets("fake").Cells(ZeileN, 1)
' ActiveSheet.AutoFilter.Range.Offset(1, 0) _
.SpecialCells(xlCellTypeVisible).Copy _
Worksheets("fake").Cells(ZeileN, 1)
End Sub
Public Function fncZeileNaechste1(Optional Spalte As Long = 1, Optional wks As Worksheet)
'Zeile nach letzter Zeile mit Inhalt in der Spalte
'Diese Function nur verwenden, wenn in der Spalte in jeder Zeile Werte eingetragen werdn.
If wks Is Nothing Then Set wks = ActiveSheet
With wks
If IsEmpty(.Cells(.Rows.Count, Spalte)) Then
fncZeileNaechste1 = .Cells(.Rows.Count, Spalte).End(xlUp).Row
If fncZeileNaechste1 = 1 And IsEmpty(.Cells(1, Spalte)) Then
fncZeileNaechste1 = 1
Else
fncZeileNaechste1 = fncZeileNaechste1 + 1
End If
Else
fncZeileNaechste1 = 0
End If
End With
End Function
Public Function fncZeileNaechste2(Optional wks As Worksheet)
'Zeile nach letzter Zeile mit Inhalt
Dim Zelle As Range
If wks Is Nothing Then Set wks = ActiveSheet
With wks
Set Zelle = .Cells.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
fncZeileNaechste2 = 1
Else
If Zelle.Row = .Rows.Count Then
fncZeileNaechste2 = 0
Else
fncZeileNaechste2 = Zelle.Row + 1
End If
End If
End With
End Function
Public Function fncZeileNaechste3(Optional wks As Worksheet)
'Zeile nach letzter Zelle mit Inhalt ungleich ""
Dim Zelle As Range
If wks Is Nothing Then Set wks = ActiveSheet
With wks
Set Zelle = .Cells.Find(what:="*", after:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious)
If Zelle Is Nothing Then
fncZeileNaechste3 = 1
Else
If Zelle.Row = .Rows.Count Then
fncZeileNaechste3 = 0
Else
fncZeileNaechste3 = Zelle.Row + 1
End If
End If
End With
End Function
Public Function fncZeileNaechste4(Optional wks As Worksheet)
'Zeile nach letzter benutzter Zeile (auch Zellen mit Formatierung gelten als benutzt)
Dim Zeile As Long
If wks Is Nothing Then Set wks = ActiveSheet
With wks
With .UsedRange
Zeile = .Row + .Rows.Count - 1
End With
If Zeile = .Rows.Count Then
Zeile = 0
Else
If Zeile = 1 And Application.WorksheetFunction.CountA(.Rows(1)) = 0 Then
Zeile = 1
Else
Zeile = Zeile + 1
End If
End If
End With
fncZeileNaechste4 = Zeile
End Function