Knap til oprettelse af nyt ark

Hej kiilerrich


Prøv evt. om du som udgangspunkt kan bruge følgende.

Jeg har døbt et ark "DefaultArk", hvorpå jeg har oprettet en kommandoknap. Bag knappen har jeg følgende kode:

----------

Private Sub cmdNytArk_Click()
Dim a As Integer    'variabel til antallet af ark
Dim n As String    'variabel til navnet på den aktive celles værdi

'tildel n den aktive celle værdi
n = ActiveCell.Value

'tildel a antallet af ark
a = ThisWorkbook.Sheets.Count

'kopier defaultarket og placer efter det sidste ark
Worksheets("DefaultArk").Copy After:=Worksheets(a)

'tildel det nye ark navnet på celleværdien i den aktive celle
ActiveSheet.Name = n

End Sub

---------

Koden tjekker ikke for sammenfald af navne på de nyoprettede ark !!!
Hvorfor der kommer en fejl ... men det kan fikses.

Jeg vender lige tilbage med hensyn til at oprette et link i den aktive celle.


Med venlig hilsen, Nicolai

Hej Kiilerrich

Der er en mindre detalje i ovenstående kode .... den kopiere nemlig også knappen med !!! ... Jeg vender lige tilbage

Mvh Nicolai

Hej Kiilerrich

Flyt blot kommandoknappen + tilhørende kode til det ark, hvorpå du vælger cellerne, som døber det nyoprettede ark.

Mvh Nicolai

Takker for den kode, den virker efter hensigten. Det med at den kopier knappen fik jeg selv løst.

Ville man også kunne gøre sådan at den også tildeler fx b1 i det ny ark sammenavn...

Hej Kiilerrich

Godt at høre, at det virker.
Jeg roder stadig lidt med det med linket i den aktive celle .....

Angående det samme navn i eksempelvis "B1" ??
Forstår jeg dig ret, så vil du ha´ arknavnet, på det nye ark, til også at stå i celle "B1" på det nye ark ???

Hvis det er korrekt ... så kopier følgende linie ind i din kode umiddelbart før "End sub"

ActiveSheet.Range("B1").Value = n


med venlig hilsen, Nicolai

Hej Lalocin.

Takker endnu engang for din hjælp og undskylder for tiden inden jeg har vendt tilbage.

Alt virker efter hensigten, har dog ikke prøvet ActiveSheet.Range("B1").Value = n endnu.

Møske du også kan hjælpe mig ved dette:

Nor nu jeg har oprettet et nyt ark efter overstående måde, så har jeg nogle koder som henter oplysninger fra de ark som jeg har oprettet.

Kode.: =INDIREKTE("'" &B43 &"'!F43")

Det jeg vil spørge omer, hvis jeg nu skal indsætte en ny linje i det oprettet ark så skifter den ikke F43 til den linje summen nu er. (håber du forstår hvad jeg mener)

Mvh

ActiveSheet.Range("B1").Value = n er nu prøvet og kan kun sige... det virker bare.. :-)

Forresten skriv et svar så du kan få dine point for hjælpen

Hej Kiilerrich

Hermed at svar.

Jeg er dog ikke kommet nærmere med hensyn til at danne et link i den aktive celle ..... ?? ... har været lidt fraværende :o)

Hvad mener du med følgende ?


Kode.: =INDIREKTE("'" &B43 &"'!F43")

Det jeg vil spørge omer, hvis jeg nu skal indsætte en ny linje i det oprettet ark så skifter den ikke F43 til den linje summen nu er. (håber du forstår hvad jeg mener)




Med venlig hilsen, Nicolai

Hej Kiilerrich

Hermed en tilrettet kode af tidligere udgave.
Koden opretter et link i den aktive celle på worksheet 2, som linker til det nyoprettede ark med navnet fra den aktive celleværdi.

Note:
Det er ikke muligt at ha´ 2 arknavne med samme navn!
Koden håndterer derfor denne del, hvis sammenfald sker ?


-----------

Private Sub cmdOpretNytArk_Click()
On Error GoTo ErrorHandler
        Dim a As Integer    'variabel til antallet af ark
        Dim n As String    'variabel til navnet på den aktive celles værdi
        Dim k As String    'variabel til adressen på den aktive celle
       
       
       
       
        'tildel n den aktive celles værdi
        n = ActiveCell.Value
       
        'tildel k den aktive celles adresse
        k = ActiveCell.Address
       
       
       
        'hvis den aktive celle er tom
        If n = "" Then
       
            MsgBox "Den aktive celle er tom", vbQuestion
       
       
        'ellers
        Else
       
            'tæl og tildel a antallet af ark
            a = ThisWorkbook.Sheets.Count
       
       
            'kopier defaultarket og placer efter det sidste ark
            Worksheets("DefaultArk").Copy After:=Worksheets(a)

   
   
            'tildel det nye ark navnet på celleværdien i den aktive celle
            ActiveSheet.Name = n
       
            'tildel værdien i celle "B1" på det nye ark ... celleværdien fra den aktive celle
            ActiveSheet.Range("B1").Value = n
           
            'tildel celle "B1" navnet n (sammen navn som værdien/arknavnet)
            ActiveSheet.Range("B1").Name = n
       
             
          'på worksheet 2 oprettes et link anker i k (adressen på den aktive celle) ... som linker til navnet n på det nye ark
          With Worksheets(2)
               
                .Hyperlinks.Add Anchor:=.Range(k), Address:="", SubAddress:=n, TextToDisplay:=(n)
         
          End With
       
       
                 
           
        End If



exit_cmd_OpretNytArk:
    Exit Sub



'fejlmeddelelse ved sammenfald af navne på arkene
ErrorHandler:

        Select Case Err.Number
                               
                'der findes allerede et ark med samme navn, så prøv igen!
                Case 1004
       
                    'indtast venligst et nyt arknavn
                  n = InputBox("Indtast venligst et nyt arknavn", "Arknavnet findes allerede!")
                     
        End Select



'fortsæt afvikling fra linien som udløste fejlen
Resume

End Sub


------


Med venlig hilsen, Nicolai