Autofilter auf anderem PC
13.05.2019 11:11:41
Carina
ich bin neu im Forum und habe mir die letzten Wochen die Basis-VBA-Kenntnisse angeeignet und einige Makros erstellt.
--> Vielen Dank hierbei für Eure Hilfe! Das Forum hat mir unglaublich weitergeholfen!!!!!
Meine Frage nun ist: Ich habe ein Makro mit einem Autofilter erstellt, dieses funktioniert auf 3 von 4 PCs, auf denen ich es getestet habe, einwandfrei. Bei einem PC funktionieren alle Makros die ich erstellt habe, bis auf jenes mit dem Autofilter.
Das ist das Makro:
Sub Neuereintrag()
With Worksheets("Meeting Minutes")
If .AutoFilterMode Then
If .FilterMode Then
.ShowAllData
End If
End If
End With
ActiveWorkbook.Worksheets("Meeting Minutes").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Meeting Minutes").AutoFilter.Sort.SortFields.Add2 _
Key:=Range("B5:B6"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Meeting Minutes").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Dim str1 As String
Dim str2 As String
'letzte gebrauchte Zelle in Spalte A
'und eine nach unten
Range("B65536").End(xlUp).Offset(1, 0).Select
'Adresse der Zelle 6 Spalten links der aktiven
'letzte "neue" in Spalte A
str2 = Range("B65536").End(xlUp).Address
'Bereich der "neuen" kopieren
Range(str2).Copy
'Ab der immer noch aktiven Zelle H
'das kopierte einfügen
ActiveCell.PasteSpecial
ActiveCell.Value = ActiveCell.Value + 1
ActiveCell.EntireRow.RowHeight = 59.75
ActiveCell.Offset(0, 10).Select
ActiveCell.Value = "offen"
ActiveCell.Offset(-1, -4).Copy
ActiveCell.Offset(0, -4).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, 9).Copy
ActiveCell.Offset(0, 9).Select
ActiveSheet.Paste
ActiveCell.Offset(-1, -14).Copy
ActiveCell.Offset(0, -14).Select
ActiveSheet.Paste
ActiveCell.Offset(0, 3).FormulaR1C1 = "-"
ActiveCell.Offset(-1, -2).Copy
ActiveCell.Offset(0, -2).Select
ActiveSheet.Paste
Range("N4").Copy
ActiveCell.Offset(0, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
ActiveCell.Offset(-1, -2).Copy
ActiveCell.Offset(0, -2).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("B5").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
ActiveSheet.Range("b5").End(xlDown).Select
End Sub
Er markiert mir bei Ausführung den Teil:
ActiveWorkbook.Worksheets("Meeting Minutes").AutoFilter.Sort.SortFields.Add2 _
Key:=Range("B5:B6"), SortOn:=xlSortOnValues, Order:=xlAscending, _
DataOption:=xlSortNormal
bitte um Eure Hilfe, dankeschön!!!
Liebe Grüße
Carina