uploads/248/Resultater.xlsx

Velbekom

uploads/248/Resultater_2.xlsx

Hvis du har en liste med alle 130 navne, kan du markere dem og køre makroen på dem.
så oprettes 130 nye Ark med definerede navne som refererer til arkenes celle A1.
Husk det skal være 130 forskellige navne, dvs du skal finde en metode hvorpå du kan
skelne mellem 2 personer med samme navn fx. Anders And. og Anders And.. og Anders And...
Bemærk antal punktum efter And
Et andet eks kunne være Anders And.1 og Anders And.2
Excel accepterer jo ikke 2 ens Arknavne eller definerede navne.
Koden fejler hvis du har et Arknavn eller et defineret navn i forvejen

Sub OpretArk()
For Each sh In Selection
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = sh
sh2 = Replace(sh, " ", "_")
ActiveWorkbook.Names.Add Name:=sh2, RefersToR1C1:=Range("A1")
Next
End Sub

Marker herefter alle ark og lav den formatering/layout/farver/streger m.v som skal være ens på alle ark
husk at fjerne arkmarkeringen igen, for alt du laver på første ark kommer med på alle ark.
Du kan markere alle ark ved at markere det første, holde SHIFT nede og markere det sidste.

Okay. Så har jeg sivet på det og rodet lidt videre med det.

Jeg har tænkt mig at lave to forskllige måde at tilføje personer til arket. Den ene er jeg godt i hang med og er som følger:

Man trykker på en knap, en dialog boks åbner, jeg indtaster navnet. Der bliver dannet et ark ud fra en skabelon, arket får navnet der er indtastet, og ligeledes bliver navnet defineret og skrevet i A1 i det nye ark.

Det jeg mangler ved den her er, at det indtastede også ryger ind på Ark1 i listen over personer.
Koden ser således ud:

Sub nytark_generator()
    arknavn = InputBox("Skriv navnet du ønsker at tilføje")
    For Each ws In Worksheets
If ws.Name = arknavn Then
MsgBox "Nummer eksisterer allerede", , "Warning!"
Exit Sub
End If
    Next
  
    Sheets("skabelon").Copy After:=Sheets("skabelon")
    ActiveSheet.Name = arknavn
    Sheets(arknavn).Range("A1") = arknavn
    Sheets(arknavn).Visible = True
    arknavn = Replace(arknavn, " ", "_")
    ActiveWorkbook.Names.Add Name:=arknavn, RefersToR1C1:=Range("A1")

End Sub

Den anden metode skal ved tryk på en knap åbne en windows stifinder dialog hvor der kan browses til et andet excel dokument, hvorfra en navne række kan hentes. Efterfølgende kan jeg så markere alle navnene og benytte den makro du allerede har lavet excelent. (kreativt navn i øvrigt ;))

Så fik jeg taget den sidste fejl ud af makroen. Til de interesserende så ser den nu sådan ud:

Sub nytark_generator()     arknavn = InputBox("Skriv navnet du ønsker at tilføje")     For Each ws In Worksheets            If arknavn = vbNullString Then Exit Sub     If ws.Name = arknavn Then     MsgBox "Navn eksisterer allerede. Har du to personer med samme skal du kalde den ene Peter Palland og den anden Peter Palland2", , "Warning!"     Exit Sub     End If         Next        Sheets("skabelon").Copy After:=Sheets("skabelon")     ActiveSheet.Name = arknavn     Sheets(arknavn).Range("A1") = arknavn     Sheets(arknavn).Visible = True     arknavn = Replace(arknavn, " ", "_")     ActiveWorkbook.Names.Add Name:=arknavn, RefersToR1C1:=Range("A1")     arknavn = Replace(arknavn, "_", " ")     Sheets("Ark1").Select     Range("A2").Select     Do Until ActiveCell.Value = ""     ActiveCell.Offset(1, 0).Select     Loop     ActiveCell.Offset(0, 0).Value = arknavn     End Sub