Finde og vælge ledige initialer

Er løst med:

Sub reserver_loginnavn()
On Error Resume Next
On Error GoTo 0

Dim oCell As Range
Dim Dest1 As Range
Dim Dest2 As Range
Dim Dest3 As Range

'åbner regneark loginnavne
Workbooks.Open "T:\Tværfaglige arbejds opgaver\Decentral Brugeradministration\mulige loginnavne.xls"
Windows("1_ansaettelsesbrev med it-blanket.xltm").Activate

'reserverer loginnavn
For Each oCell In ActiveSheet.Range("H7")
Set Dest1 = Range("mulige_loginnavne").Find(What:=oCell).Offset(0, 1)
Dest1 = Range("c7")
Set Dest2 = Range("mulige_loginnavne").Find(What:=oCell).Offset(0, 2)
Dest2 = Date
Set Dest3 = Range("mulige_loginnavne").Find(What:=oCell).Offset(0, 3)
Dest3 = "Oprettet af " & Environ("username")
Next oCell

'lukker regneark
Workbooks("mulige loginnavne.xls").Close SaveChanges:=True

MsgBox ("Initialerne " & Range("h7") & " blev reserveret i listen med loginnavne"), vbInformation, "Loginnavn reserveret"
slut:
End Sub