Kopi af fane, ændring af celle

Det er det da, men kræver nok en smule finesse i din kode - send den så kan vi tilrette.

Sub Opret_nye_faner_2()
    Sheets("Hovedark").Activate
    Range("A8:A37").Select
    On Error GoTo fejl
    For Each c In Selection.Cells
      ' sname = c.Value (sname bruges ikke til noget!)
        If Not IsEmpty(c) Then
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
        End If
    Next c
   

Worksheets("Hovedark").Activate

Worksheets("Hovedark").Range("A8:A37").Select
For Each c In Selection.Cells
    If Not IsEmpty(c) Then
        Worksheets("Titel 1 test").Cells.Copy
        Worksheets(c.Value).Paste
    End If
Next c
   
   
    Exit Sub
fejl:
    If Err.Number = 1004 Then
        MsgBox "Mindst et af de ark, du prøver at oprette eksisterer allerede" & vbCrLf & _
        "Ret fejlen og prøv igen", vbOKOnly + vbCritical
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub

Det der skal ændres er fx celle B3 i det kopirede ark. Den henter herfra =Hovedark!B8. I den næste fane skal den gerne hente fra C8 i stedet.

Jeg tror ikke helt jeg forstår, måske jeg ikke læser koden rigtigt (eller du har kopieret den ud af kontekst).

Du markerer et område, hver enkelt at de celler du har markeret skaber et faneblad hvor navnet er værdien i cellen (forudsat cellen ikke er tom).
Så kopierer du hele området fra dit hovedark igen og sætter det ind i et ark der er navngivet test.

Jeg antager c er kolonne, men jeg kan ikke se en definition.

Jeg har 2 ark. Et hovedark hvor jeg taster title stk. osv i. Så har jeg et beregningsark (Title 1 test) hvor talene bliver brugt. Det min makro gør nu er at oprette en kopi af Title 1 test og navngive det efter listen af titler.
Det jeg ønsker at gøre er at referencerne opdatere i forhold til fanerne. Så fanen for title 2 også henviser til oplysningerne i hovedarket matchene title 2.

Håber det giver mening

Jeg er ked af det, jeg forstår ikke ud det din kode viser når jeg så sammenholder med det du beskriver.
Kan du uploade arket et sted så vi kan se.

Hvor I din kode indsættes de formler du taler om?

De bliver ikke indsat i koden. De er bare i selvearket, hvor der er oprettet en formel der henter værdierne.

Så arket har alle formler, men du vil have dem til kun at have nogen af dem? Eller vil du ændre formlerne i hvert ark?

Jeg vil ændre formlerne i hvert ark. Fx som det er nu hedder celle B3 i det ark der bliver kopieret ud til de nye ark, "=Hovedark!B8". I det næste ark der bliver oprettet vil jeg gerne at B3 hedder "=Hovedark!B9" osv. Altså for hvert ark der bliver oprettet skal =Hovedark!B8+1

En løsning kunne så være at lave en ændring i dette:
For Each c In Selection.Cells
    If Not IsEmpty(c) Then
        Worksheets("Titel 1 test").Cells.Copy
        Worksheets(c.Value).Paste
    End If
Next c

F.eks. indsætte formlen der skal laves, den kan du så lave ved at bruge c igen. Noget a la (utestet og sikkert ikke komplet formuleret):
range("B3").formula = "=Hovedark!B" & c+et eller andet (alt efter hvilken værdi c har når du starter)
Hvis formlen bruges flere steder - altså B4 skal være Hovedark!B10 eller lignende skal du så lave kopiering, eller flere linjer som det eksempel jeg gav.

Det vil jeg prøve at se om det virker. Tak for hjælpen indtil videre.

http://www.filedropper.com/tester_3 her er arket. Jeg kan ikke få det til at virke :( Jeg vil gerne have de forskellige titler hest, hund, kat ind i celle B3 på den fane som den hører til.

https://www.dropbox.com/s/573v493xkw91duu/Tester.xlsm?dl=0

Jeg kom på en lidt anderledes løsning i steder.

Jeg har i dit testark lavet et opslag i B3 som henter fra C3 (teksten i sidstnævnte er gjort hvid). Så indsættes navnet blot i arket og den slår op mod din master.

Jeg gjorde også din kode lidt simplere da du tager det i to tempi, fremfor et.

Bemærk jeg gjorde range'n mindre for at have nemmere ved at teste - den skal måske også tilrettes igen.

Koden lyder nu:
Sub Opret_nye_faner_2()


    Sheets("Hovedark").Activate
    Range("A8:A11").Select
    On Error GoTo fejl
    For Each c In Selection.Cells
        If Not IsEmpty(c) Then
            Sheets.Add After:=Sheets(Sheets.Count)
            ActiveSheet.Name = c.Value
            Worksheets("Titel 1 test").Cells.Copy
            Worksheets(c.Value).Paste
            Worksheets(c.Value).Range("C3").Select
            ActiveCell.Formula = c.Value
        End If
    Next c
   
    Exit Sub
fejl:
    If Err.Number = 1004 Then
        MsgBox "Mindst et af de ark, du prøver at oprette eksisterer allerede" & vbCrLf & _
        "Ret fejlen og prøv igen", vbOKOnly + vbCritical
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub

Sådan, det virker perfekt! Mange mange tak for hjælpen.

Lige et tillægsspørgsmål. Er der muligt at gemme indstillingerne på det ark der kopieres? Fx at der ikke vises gitterlinjer i de nye ark?

Det kan du da, så tænker jeg du skal kopiere hele arket, fremfor at oprette nyt ark, navngive og kopiere celler.

Prøv at bruge optageren til at se koden, derefter erstat dette:

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Worksheets("Titel 1 test").Cells.Copy
Worksheets(c.Value).Paste

Virker desværre ikke, den opretter godt nok en kopi af arket, men den opretter ikke den ønskede mængde ark. Men pyt jeg bruger det jeg har. Mange tak for hjælpen