Makro og VBA - Oprette og navngive flere faner + kopiere indhold

Print side | Luk vindue

Oprette og navngive flere faner + kopiere indhold

Udskrevet fra: Dansk Regneark Forum
Kategori: Hjælp til regneark.
Forum navn: Makro og VBA
Forum beskrivelse: Hjælp til Makroer og VBA-programmering
Web-adresse: https://forum.excel-regneark.dk/forum_posts.asp?TID=468
Udskrevet den: 05.Dec.2024 kl. 03:11

Emne: Oprette og navngive flere faner + kopiere indhold

Besked fra: Maring78
Emne: Oprette og navngive flere faner + kopiere indhold
Posteringsdato: 19.Sep.2011 kl. 16:28

Hej!

Har et regneark som indeholder 7 faner:

4 skjulte faner

1 fane man kan indtaste i (C_1)

1 fane der opsummerer fra indtastningsarket (C_SUM)

1 fane der fungerer som forside og vejledning til modellen

Step1: Vil gerne sætte noget automatik op der gør, at man i en kolonne kan angive navne som når makroen køres oprettes som nye faner. Eksempelvis kunne der stå: C_2, C_3 og C_4 i kolonnen og makroen skal så oprette fanerne C_2, C_3 og C_4.

Step2: Derudover skal alle nye faner indeholde samme formler og format som der er i fanen C_1.

Step3: Efterfølgende skal C_SUM opdateres så det summerer alle C-faner inkl. de nye der er kommet til.

Tænker umiddelbart første step er at oprette alle fanerne – til den del har jeg denne kode som virker fint:

………….

On Error GoTo fejl

For Each c In Selection.Cells

sname = c.Value

If Not IsEmpty(c) Then

Sheets.Add

ActiveSheet.Move After:=Sheets(Sheets.Count)

ActiveSheet.Name = 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

………….

Men går så lidt kold i step 2… muligvis kan man med fordel kopiere og oprette samtidig.

Der skal være mulighed for at oprette 30-40 faner.

Er der nogen der har en løsning?

Svar:

Besked fra: rassten
Posteringsdato: 20.Sep.2011 kl. 15:59

Hej
I forbindelse med Step 2, ville jeg nok lave en smule om i din makro:



            Sheets.Add

            ActiveSheet.Move After:=Sheets(Sheets.Count)

bliver til:


            Sheets("C_1").Activate
            ActiveSheet.Copy After:=Sheets(Sheets.Count)

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Maring78
Posteringsdato: 23.Sep.2011 kl. 15:02

Super! Der virker :-)

Den går dog kold efter at have oprettet 26 faner og hopper til fejlmeddelelsen?

Besked fra: Maring78
Posteringsdato: 23.Sep.2011 kl. 15:25

Til info: Er total set oppe på 34 faner, når de 26 nye er oprettet...

Besked fra: rassten
Posteringsdato: 24.Sep.2011 kl. 02:33

Der er ikke noget i din kode som gør at den burde stoppe ved et vist antal ark. Og jeg mener at det vist før i tiden kun var computeres ram som kunne sætte en begrænsning for antallet af ark, skjulte eller synlige er ligegyldigt.

Så umiddelbart kan jeg kun se, at du er kommet til at at ville lave give to ark samme navn. Måske et af de synlige hedder det samme som et usynligt.

Prøv at slette alle tidligere makro fremstillet ark, lav en navne liste og kør makroen igen.
Hvis det samme sker igen, så prøv at uploade din fil, så er sikkert flere her som gerne vil hjælpe.

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Maring78
Posteringsdato: 26.Sep.2011 kl. 15:14

Hej igen

Har prøvet koden i et andet og rent regneark, og der virker det fint... I mit eget gamle regneark som er temmelig tungt kommer den med fejlen efter at have oprettet 28 nye faner. Den skulle helt kunne kapere mindst 40 før jeg er i mål.

Koden Ser således ud:

Sub Opret_nye_faner()

Sheets("A").Select
Range("H18:H58").Select

    On Error GoTo fejl
    For Each c In Selection.Cells
        sname = c.Value
        If Not IsEmpty(c) Then
            Sheets("B").Activate
            ActiveSheet.Copy After:=Sheets(Sheets.Count)

            ActiveSheet.Name = 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

Hvis det ikke umiddelbart er åbenlyst, hvordan fejlen opstår, så er det sikkert et ressourceproblem i Excel. I så fald kunne man måske så ændre koden, så alle fanerne bliver oprettet først og dernæst kopieres indholdet i B til alle de nye faner?

Besked fra: rassten
Posteringsdato: 26.Sep.2011 kl. 18:06

Prøve denne


Sub Opret_nye_faner_2()
    Sheets("A").Activate
    Range("H18:H58").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("A").Activate
 
 Worksheets("A").Range("H18:H58").Select
 For Each c In Selection.Cells
    If Not IsEmpty(c) Then
        Worksheets("B").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

Pas på med datoer i kolonne H i ark A
Men jeg kan ikke lide hvis den første koden skulle stoppe et vilkårligt sted.
Hvis det skulle være et spørgsmål om ressource har du enten et utroligt stort ark B eller ikke ret meget ram i din computer .

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Maring78
Posteringsdato: 26.Sep.2011 kl. 23:08

Endnu en gang mange tak for hjælpen :-)

Kan heller ikke forstå, hvorfor den første kode ikke virker. Men det er rigtigt nok et temmelig tungt ark B jeg har.

Mht. den nye kode ovenfor, så virker det umiddelbart fint med at oprette arkene, men den går kold ved det næste step og kommer med fejlmeddelsen?

Besked fra: rassten
Posteringsdato: 27.Sep.2011 kl. 01:45

Jeg har lige prøvet at kørere koderne på en fil som voksede fra 32 MB til 95 MB, det var ganske vist langsomt, men jeg fik ikke nogen fejl. Og det på en gammel xp som er mindst 5 år gammel.
Jeg kan ikke se i nogen af koderne at der skulle være et problem. Men måske andre kan se noget jeg ikke kan.
runtime 1004, er en meget general fejlkode, som vil dække over mange forskellige problemer.
Men hvis den sidste kode virkede indtil det sidste loop, kunne det måske skyldes et problem med Ark B.
Hvis du på nogen måde har beskyttet celler i ark B, skal du først fjerne denne beskyttelse.
Du skal også helst undgå Flettede celler, noget generelt skidt som ser pænt ud, men næsten altid giver problemer.
Der er ganske vist en begrænsning på 5 mb upload i dette forum, men hvis din fil skulle fylde mindre end dette kunne du prøve at uploade den, så er der sikkert flere som gerne vil kikke på den.

Hvis dette ikke skulle være muligt, så prøv at give os listen i kolonne H.
Jeg kan kun fremprovokere fejl hvis jeg bruger ulovlige tegn, eller hvis jeg bruger datoer som excel omformatere når arkene bliver navngivet.

-------------
VH rassten

Arbejde excel 2010
Privat excel 2010

Besked fra: Maring78
Posteringsdato: 27.Sep.2011 kl. 15:41

Har fået det til at virke ved at hoppe over i Excel 2007. Før kørte jeg det hele i Excel 2000. Tror simpelthen der må være tale om et ressourceproblem i Excel. Som sagt er det nogle temmelig tunge faner jeg tumler med.... I Excel 2007 fylder filen også betydeligt mindre, når den jeg gemmer dem.

Endnu en gang mange tak for hjælpen.

Der er sidenhen opstået et nyt spørgsmål i en lidt anden kategori. Opretter en ny tråd.

:-)

Print side | Luk vindue