Sub SletRaekke(Medarb As String)

ArkNavn = "Medarbejder"
Omraade = "A2:A400"

For Each c In Sheets(ArkNavn).Range(Omraade).Cells
    If c.Value = Medarb Then
        c.Value = ""
        MsgBox Medarb & " er nu slettet fra arket " & ArkNavn, vbInformation
    End If
Next c
On Error Resume Next
Sheets(ArkNavn).Range(Omraade).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Activate
End Sub
Sub SletArkiv(Medarb As String, Anr As String)

ArkNavn = "Arkiv"
Omraade = "A2:A400"

For Each c In Sheets(ArkNavn).Range(Omraade).Cells
    If c.Value = Medarb And c.Offset(0, 1).Value = Anr Then
        c.Value = ""
        MsgBox Medarb & " med Anr " & Anr & " er nu slettet fra arket " & ArkNavn, vbInformation
    End If
Next c
On Error Resume Next
Sheets(ArkNavn).Range(Omraade).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Range("A1").Activate
End Sub

Sub Skab()

Ark3.Range("A2:R400").ClearContents

Raekke = 2

For Each kolonne In Ark3.Range("A1:P1").Cells
    For Each c In Ark5.Range("C2:C400").Cells
        If Len(c.Value) <= 3 Then
            If Left(c.Value, 1) = LCase(kolonne.Value) Then
                If Application.WorksheetFunction.CountIf(Sheet2.Range("F2:U400"), c.Value) < 1 And _
                    Application.WorksheetFunction.CountIf(Ark5.Range("e2:e400"), c.Value) < 1 Then
                    Ark3.Range(kolonne.Value & Raekke).Value = c.Value
                    Raekke = Raekke + 1
                End If
            End If
        Else
            If Application.WorksheetFunction.CountIf(Sheet2.Range("F2:U400"), c.Value) < 1 And _
                Application.WorksheetFunction.CountIf(Ark4.Range("c2:c400"), c.Value) < 1 And _
                 Application.WorksheetFunction.CountIf(Ark3.Range("Q2:Q400"), c.Value) < 1 Then
                    Ark3.Range("Q" & Raekke).Value = c.Value
                    Raekke = Raekke + 1
            End If
        End If
    Next c
Next kolonne
End Sub