Kopier ark og navngiv det

Endnu engang en konkret problemstilling. I en mappe findes et antal fark, benævnt 1.1, 1.2, 1.3, 2.1, 2.2, 2.3, 3.1, 3.2, 4,1 osv. Vi vil nu gerne lave en mako, der kan kopiere det sidste ark i en serie, altså fx 1.3, 2.3, 3.2 eller 4.1. Det nye asrk så skal så have et nummer højere, fx 1.4 eller 4.2.

Makroen viser en inputbox, hvor man skal indtaste navnet på det ark, man ønsker at kopiere. Er dette ark, ikke det sidste i en serie, vises en fejlmeddelelse, og man kan prøve igen. Det samme sker, hvis man taster navnet på et ark, der ikke eksisterer. Taster man cnavnet, på et ark, der eksisterer, men ikke har et "serienummer", sker der intet, men man får at vide, at der er opstået en "ukendt" fejl. Denne meddelelse vil også bleive vist i andre situationer, hvor der opstår uventede fejlkoder.

Sub KopierogOmdoeb()
    On Error GoTo Fejl

    Dim name As String, numm As String, lastpart As String, firstpart As String, Ark As String

    Ark = InputBox("Skriv navnet på det ark, der skal kopieres. Det skal være det sidste ark i en serie")
    Sheets(Ark).Activate

    name = ActiveSheet.name
    numm = InStrRev(name, ".", Len(name))
    numm = CInt(numm)

    lastpart = CInt(Mid(name, numm + 1, Len(name)))
    firstpart = Left(name, InStrRev(name, ".", numm))

    ActiveSheet.Copy after:=ActiveSheet

    ActiveSheet.name = firstpart & lastpart + 1
    Exit Sub

Fejl:
    If Err.Number = 1004 Then
        MsgBox "Du prøver at kopiere et ark, der ikke er det sidste i en serie. Prøv igen!", vbExclamation, vbOKOnly
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    ElseIf Err.Number = 9 Then
        MsgBox "Det ark, du vil kopiere findes ikke. Prøv igen", vbExclamation, vbOKOnly
    Else
        MsgBox "Der er opstået en ukendt fejl. Prøv igen!", vbCritical, vbOKOnly
    End If

End Sub

- Tilbage til makroer -
- Tilbage til Excel -