27. december 2007 - 16:33Der er
10 kommentarer og 1 løsning
Hente ark nr. til celle
Hej alle...
Har et ark "Index .223" hvor jeg i celle "O2" indtaster et nr. på et nyt ark, som bliver oprettet når jeg trykker på en knap.
Det jeg gerne vil have, er at det nr. jeg taster bliver overført til "index .223" arket i "B" kolonnen og det nye ark i celle "AZ5:BB5"
Det skal lige siges at i "Index .223" arket bliver hver celle kun brugt en gang, de nye ark bliver listet under hinanden nedefter i kolonne "B"
En sidste ting er, kan man lave koden så den "advarer" hvis man er ved at oprette et ark nr. som allerede eksistere, i dag får jeg en Run-Time error 1004 fejl om at arket ikke kan hedde det samme som et allerede eksisterende ark.
Koden som jeg indtil videre bruger ser sådan her ud:
Sub AddWorksheetExample() Application.EnableEvents = False Range("o2").Select Dim wksNewSheet As Excel.Worksheet Dim wksNewSheets As Excel.Worksheet detteark = ActiveSheet.Name navn = ActiveCell.Value Set wksNewSheet = Worksheets.Add wksNewSheet.Name = navn Sheets(detteark).Activate Selection.ClearContents Sheets("Master").Select Cells.Select Selection.Copy wksNewSheet.Select Cells.Select ActiveSheet.Paste ActiveWindow.DisplayHeadings = False Range("F15:H15").Select
Sheets("Data2").Select Rows("1:1").Select Selection.Copy Sheets("Index .223").Select Range("A65536").End(xlUp).Offset(2, 0).Select ActiveSheet.Paste End Sub
Jeg er ikke sikker på, at jeg har forstået præcis, hvad du ønsker men prøv dette og lad mig vide, hvad der mangler.
Sub AddWorksheetExample() Application.EnableEvents = False On Error GoTo fejl Range("o2").Select Dim wksNewSheet As Excel.Worksheet Dim wksNewSheets As Excel.Worksheet detteark = ActiveSheet.Name navn = ActiveCell.Value Set wksNewSheet = Worksheets.Add wksNewSheet.Name = navn Sheets(detteark).Activate Selection.ClearContents Sheets("Master").Select Cells.Select Selection.Copy wksNewSheet.Select Cells.Select ActiveSheet.Paste ActiveWindow.DisplayHeadings = False Range("F15:H15").Select
Sheets("Data2").Select Rows("1:1").Select Selection.Copy Sheets("Index .223").Select Range("A65536").End(xlUp).Offset(2, 0).Select ActiveSheet.Paste Range("b65536").End(xlUp).Offset(1, 0).Value = navn Exit Sub fejl: If Err.Number = 1004 Then MsgBox "Du kan ikke oprette et ark med dette nummer, da det allerede eksisterer", _ vbOKOnly + vbCritical End If
Det må kunne gøres ved at ændre til Range("b65536").End(xlUp).Offset(3, 0).Value = nav
Msgbox'en må jeg lige tænke over. Problemet er, at fejlen først opstår, når arket skal omdøbes. Det indsættes uden problemer, men kan ikke navngives, men det kan der findes en løsning på, hvor man undersøger de ark, der allerede er i mappen. Den kigger jeg lige på.
Den sidste er jweg ikke helt med på. Skal nummeret stå i alle cellerne AZ5, BA5 og BB5?
Omkring indsættelse af nummer, har jeg fundet fejlen... det var mig der bøffede i den, da de 2 første celler stod tomme, blev de selvfølgelig valgt først.
jeg har sat det med at tjekke om arket eksisterer ind i koden:
Sub AddWorksheetExample() Application.EnableEvents = False On Error GoTo fejl Range("o2").Select Dim wksNewSheet As Excel.Worksheet Dim wksNewSheets As Excel.Worksheet detteark = ActiveSheet.Name navn = ActiveCell.Value
For Each sh In ActiveWorkbook.Sheets If sh.Name = navn Then MsgBox " Aket eksisterer" Exit Sub End If Next
Set wksNewSheet = Worksheets.Add wksNewSheet.Name = navn Sheets(detteark).Activate Selection.ClearContents Sheets("Master").Select Cells.Select Selection.Copy wksNewSheet.Select Cells.Select ActiveSheet.Paste ActiveWindow.DisplayHeadings = False Range("F15:H15").Select
Sheets("Data2").Select Rows("1:1").Select Selection.Copy Sheets("Index .223").Select Range("A65536").End(xlUp).Offset(2, 0).Select ActiveSheet.Paste Range("b65536").End(xlUp).Offset(1, 0).Value = navn Exit Sub fejl: If Err.Number = 1004 Then MsgBox "Du kan ikke oprette et ark med dette nummer, da det allerede eksisterer", _ vbOKOnly + vbCritical End If
Den når stadig at oprette et nyt ark (dog kun et tomt et) inden boxen popper op.
Har selv redigeret lidt i koden og har fået den til at kopiere nr. til det nye ark.
Sub AddWorksheetExample() Application.EnableEvents = False On Error GoTo fejl Range("o2").Select Dim wksNewSheet As Excel.Worksheet Dim wksNewSheets As Excel.Worksheet detteark = ActiveSheet.Name navn = ActiveCell.Value Set wksNewSheet = Worksheets.Add wksNewSheet.Name = navn Sheets(detteark).Activate
Sheets("Index .223").Select Range("O2").Select Selection.ClearContents Exit Sub fejl: If Err.Number = 1004 Then MsgBox "Du kan ikke oprette et ark med dette nummer, da det allerede eksisterer", _ vbOKOnly + vbCritical End If
Har ikke helt fået svar på mit spørgsmål og har ikke fået koden til at virke optimalt.
Har derfor valgt en anden opstilling og lukker derfor spørgsmålet, i skal ha´ tak for forsøgene.
VH. Michael
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
