De er - indtil videre - inddelt i følgende grupper:

ARK

Sub Indsætmdrark()
Dim X As Integer
Worksheets.Add Count:=12
For X = 1 To 12
Worksheets(X).Name = Format(DateSerial(1997, X, 1), "mmmm")
Next X
End Sub
 

Sub OphævArkBeskyttelse()
Dim Wb As Workbook, Sh As Worksheet
For Each Wb In Workbooks
For Each Sh In Wb.Worksheets
Sh.Unprotect
Next Sh
Next Wb
End Sub
 

Sub Rullebegrænsning()
If ActiveSheet.ScrollArea = "" Then
Cells.Interior.ColorIndex = 17
Selection.Interior.ColorIndex = xlColorIndexNone
ActiveSheet.ScrollArea = Selection.Address
Else
ActiveSheet.ScrollArea = ""
Cells.Interior.ColorIndex = xlColorIndexNone
End If
End Sub
 

Sub Arkmeddatoerimdr()
Dim i As Integer
For i = 1 To 30
Worksheets(i).Name = Format(DateSerial _
(2001, 4, i), "dd.mm.yy")
Next i
End Sub

Sub DeleteSheet(strSheetName As String)
' deletes a sheet named strSheetName in the active workbook
    Application.DisplayAlerts = False
    Sheets(strSheetName).Delete
    Application.DisplayAlerts = True
End Sub
 

Celle

Sub AfkortCelleKarakterer()
Dim C As Range
On Error Resume Next
For Each C In Selection
C = Left(C, 10)
Next C
End Sub
 

Sub Hvorerdenaktivecelle()
Dim Område As Object
Set Område = Application.Intersect(Range("i1:l10"), Range(ActiveCell.Address))
If Område Is Nothing Then MsgBox "Udenfor området" Else MsgBox "I området"
End Sub
 

Sub Nulstiltekstceller()
Dim C As Range
For Each C In Selection
If Not IsNumeric(C.Value) Then
C.Value = 0
End If
Next C
End Sub

Sub Kommentarfeltstørrelse()
Dim nykom As Comment
Set nykom = ActiveCell.AddComment
With nykom
.Text Text:=Application.UserName & ":" _
& Chr(10) & ""
With .Shape
.Height = 100
.Width = 100
End With
End With
End Sub

Sub Kommentaroverskriveshvisja()
Dim C As Range
For Each C In Selection
If Not C.Comment Is Nothing Then
C.NoteText "Opr kommentar er overskrevet af dette !"
End If
Next C
End Sub
 

Sub Viscelleværdi()
MsgBox Range("A10").Text
End Sub
 

Kopier celler, med flg kode:
Selection.Copy

Indsæt kopierede celler, med flg kode:
ActiveSheet.Paste

Kolonner

Sub SkjulFlereKol()
Dim Område As Range
Application.Goto Reference:=Range("d:f,h:i,k:n")
For Each Område In Selection.Areas
Område.EntireColumn.Hidden = True
Next Område
End Sub

Sub VisIgenFlereKol()
Dim Område As Range
Application.Goto Reference:=Range("d:f,h:i,k:n")
For Each Område In Selection.Areas
Område.EntireColumn.Hidden = False
Next Område
End Sub
 

System

Sub WindowsSystem()
If InStr(1, Application.OperatingSystem, "32") Then
MsgBox "32-Bit-System"
Else
MsgBox "16-Bit-System"
End If
End Sub
 

Sub Sprognummer()
MsgBox Application.International(1)
End Sub

Undgå diverse alerts med flg kode:
Application.DisplayAlerts = False

Når du vil se dem igen, brug da flg. kode:
Application.DisplayAlerts = True

Undgå alerts (fil gem)  med flg kode:
ActiveWorkbook.Close False ' lukker den aktive fil UDEN at gemme ændringer

Når du vil se dem igen (fil gem), brug da flg. kode:
ActiveWorkbook.Close True ' lukker den aktive fil og gemmer alle ændringer

Når du vil aktivere en anden åben fil, brug da flg. kode:
Windows("filnavnet.xls").Activate

Når du vil indsætte en tekst i Statusbar'n, brug da flg. kode:
Application.StatusBar = "Alan Excel"

Søg

Sub SøgAccessExport()
Dim a As Range
Dim SøgMål
SøgMål = InputBox("Indtast det eftersøgte:")
If SøgMål = "" Then Exit Sub
For Each a In Selection
If a >= SøgMål - 1 And a <= SøgMål + 1 Then
a.Select
Exit Sub
End If
Next a
MsgBox "Det eftersøgte blev ikke fundet !"
End Sub