VBA - USER DEFINED FUNCTIONS

OBJEKTE:   BEREICHE

Public b1 As Range
Public Zeilenzahl As Integer

Sub LeereZellen()
Set b1 = Selection.SpecialCells(xlEnd)
Zeilenzahl = Selection.Rows.Count
End Sub

' Bereiche markieren
Sub BereichMarkieren()
Range("A1").Select
Selection.SpecialCells(xlLeereZellen).Select
Selection.CurrentRegion.Select
End Sub

' Formeln durch berechnete Werte ersetzen
Sub FormelErsetzen()
Range("A1").Select
Selection.Copy
Range("A3").Select
Selection.PasteSpecial Paste:=xlFormulas, _
Operation:=xlNone, SkipBlanks:=True, Transpose:=True
End Sub

Sub Kopieren()
'Abfrage eines Zellbereiches und kopieren mit Zwischenablage
'Kopierter Bereich wird anschließend formatiert
Dim ZB As Variant
ZB = InputBox("Bitte Zellbereich eingeben")
Range(ZB).Select
Selection.Kopieren
ergebnis = MsgBox("Kopieren erfolgreich", 64, "Titel")
Range("A4").Select
ActiveSheet.Paste
Application.CutCopyMode = False
With Selection.Font
    .Name = "Arial"
    .FontStyle = "Fett"
    .Size = 10
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlNone
    .ColorIndex = xlAutomatic
End With
End Sub


Sub ZeileAuswählen()
Dim AktuelleZelle As Object, Zelle1 As Object, Zelle2 As Object
Dim Zeile As Integer, Spalte As Integer
Set AktuelleZelle = ActiveCell
Zeile = AktuelleZelle.Row: Spalte = AktuelleZelle.Column
If IsEmpty(AktuelleZelle) Then Exit Sub
    ' linkes Zeilenende suchen, Endzelle in zelle1 speichern
    For Spalte = AktuelleZelle.Column To 1 Step -1
        If IsEmpty(Cells(Zeile, Spalte).Value) Then
        Set Zelle1 = Cells(Zeile, Spalte + 1)
    Exit For
End If
Next Spalte
If Zelle1 Is Nothing Then Set Zelle1 = Cells(Zeile, 1)
    ' rechtes Zeilenende suchen, Endzelle in Zelle1 speichern
    For Spalte = AktuelleZelle.Column To MaxSpalteen
        If IsEmpty(Cells(Zeile, Spalte).Value) Then
        Set Zelle2 = Cells(Zeile, Spalte - 1)
    Exit For
End If
Next Spalte
If Zelle2 Is Nothing Then Set Zelle2 = Cells(Zeile, 256)
' den Bereich zwischen Zelle1 und Zelle2 markieren
Range(Zelle1, Zelle2).Select
End Sub