Excel - kopiera arbetsblad

[solbulle]

Excel.

Min tanke är att ha en sida som ett formulär där man kan fylla i och göra en del beräkningar.

 

Sen vill jag med hjälp av en knapp kunna kopiera, av mig i förväg valda delar, av bladet, med fasta värden, ej med referenser till db eller andra blad el dyl. Funktioner behöver ej följa med utan bara dess värden.

 

Det nya arket skall placeras längst bak i arbetsboken helst med ett namn som är taget från en cell i bladet.

Vidare ska jag även koppla till en utskriftsfunktion, men det blir ett senare (lättare?) problem.

 

Jag har tittat på XLDennis eminenta sida och främst hans "KopieraRader_SkrivUtArbetsblad" http://www.xldennis.com/kopierataderskrivut(vba).htm vilket ger en bra hjälp på vägen.

 

Det jag inte riktigt förstår är hur jag i princip skall kunna kopiera hela mitt blad, bortsett från då referenser samt knappar mm

[XL-Dennis]

Solbullen,

 

Tack för ditt omdöme om min webbplats :-)

 

Följande procedur kopierar det aktiva bladet och lägger det nya bladet sist i arbetsboken. Den omvandlar formler till konstanta värden:

 

Sub Lagg_till_Resultatblad()

'© 2002 XL-Dennis

Dim wsBlad As Worksheet

Dim rnCell As Range

Dim i as Integer

 

Application.ScreenUpdating = False

i = Worksheets.Count

ActiveSheet.Copy after:=Worksheets(i)

i = i + 1

Set wsBlad = Worksheets(i)

 

On Error Resume Next

 

For Each rnCell In wsBlad.Cells.SpecialCells(xlFormulas)

rnCell.Value = rnCell.Value

Next

Application.ScreenUpdating = True

End Sub

 

 

Mvh

Dennis

http://www.xldennis.com

 

[solbulle]

Lysande& snabbt svar.

Fungerar iofs perfekt, men...

Är det möjligt att låta det nya bladet få ett namn baserat på ett cellinnehåll?

 

typ: namnfield = Range("A1").FormulaR1C1

.Name = namnfiel

 

el liknande?

 

Samt, kan jag (du?) göra så att scriptet INTE kopierar med formulärknappar samt går det att ev. utelämmna en del celler från orginalet?

 

[paramoz]

Om du vill ha ett namn baserat på cellinnehåll kan du stoppa in följande kod:

 

Namn = Range("A1") 'valfri cell

ActiveSheet.Copy After:=Worksheets(i)

ActiveSheet.Name = Namn

 

Tänk på att namnet måste vara giltigt. Finns säkert en enradslösning, orkar dock inte tänka ut den nu.

 

Om du vill hoppa över vissa celler kan du lägga in if-satser under For Each och om det är en viss rad eller ett visst innehåll kan du hoppa över dem.

 

[XL-Dennis]

solbulle,

 

Bladnamn:

Följande kodsnutt hämtar värdet i cellen A1 och tilldelar namnet till det nya arbetsbladet:

 

Dim stNameField As String

 

stNameField = CStr(Range("A1").Value)

wsBlad.Name = stNameField

 

Utelämna celler:

Enklast är faktiskt att ta bort värdena från dessa celler i det nya arbetsbladet.

 

t ex: wsblad.Range("H1:H40").Clear

 

Förhindra formulärknappar:

Utgår från att du använder de kontroller som återfinns i verktygsfältet "Formulär".

 

Samma lösning föreslås här, att dessa tas bort från det nya bladet.

 

Dim oObjekt As Object

 

With wsBlad

For Each oObjekt In .Shapes

oObjekt.Delete

Next

End With

 

Sätter vi ihop dessa ”tillägg” så kan det se ut på följande sätt:

 

With wsBlad

For Each oObjekt In .Shapes

oObjekt.Delete

Next

.Name = stNameField

.Range("H1:H40").Clear

End With

 

Mvh

Dennis

http://www.xldennis.com

 

[solbulle]

 

Jag bara sitter o garvar, det fungerar ju kanon nu, helt suveränt!

 

Var faktist inne lite på det själv, att det nog skulle vara bäst att radera efter kopieringen.

Nu tror jag bara att det är en liten detalj, om man glömmer att "döpa om" arbetsbladet, dvs den cell som representerar det nya bladets namn, kan man på något sätt få en något snyggare varning alt. ev. ett namn typ namn(2) som man fick innan min/din senaste ändring?

(Kanske bara jag som placerat koden fel?)

 

[XL-Dennis]

solbulle,

 

Roligt att du upplever det som "magic" :-)

 

Så här ser min slutgiltiga procedur ut

och som fungerar:

 

Sub Lagg_till_Resultatblad()

'© 2002 XL-Dennis

Dim stNameField As String

Dim oObjekt As Object

Dim wsBlad As Worksheet

Dim rnCell As Range

Dim i As Integer

 

Application.ScreenUpdating = False

i = Worksheets.Count

ActiveSheet.Copy after:=Worksheets(i)

i = i + 1

Set wsBlad = Worksheets(i)

 

'Ifall det inte finns formler

On Error Resume Next

 

For Each rnCell In wsBlad.Cells.SpecialCells(xlFormulas)

rnCell.Value = rnCell.Value

Next

Application.ScreenUpdating = True

 

stNameField = CStr(wsBlad.Range("A1").Value)

 

With wsBlad

For Each oObjekt In .Shapes

oObjekt.Delete

Next

.Name = stNameField

.Range("H1:H40").Clear

End With

 

End Sub

 

Testa och hör av dig om utfallet,

 

Mvh

Dennis

http://www.xldennis.com

 

[solbulle]

Jo, det fungerar helt ok, när jag väl fattade vad jag gjort fel... (glömde ändra en cellreferens)

 

Fungerar helt kanon, fattar bara inte varför jag inte ställt frågor i detta forum tidigare...

 

[XL-Dennis]

solbulle,

 

Roligt att du fick till det :-)

 

En liten sak jag noterade är att raden

Application.ScreenUpdating = True

kan flyttas ned till raden innan

End Sub samt lägga till en rad längst ned

för att återställa felhanteringen

On Error Goto 0

 

Sådär - case closed ;-)

 

Mvh

Dennis

http://www.xldennis.com

 

[inlägget ändrat 2002-01-10 00:08:09 av XL-Dennis]

[solbulle]

 

En liten sak till...

 

Jag har en bild i mitt blad som jag gärna skulle vilja ha kvar i det kopierade bladet.

Går det att låta bli att radera den (tillsammans med knapparna) eller går det att klistra in den efteråt?

 

 

 

[solbulle]

Ja, det gick att klistra in en bild på nytt i det nya bladet, löste det på så sätt.

Hittar dock inget sätt att komma åt den befintliga bilden.

 

[solbulle]

La till:

 

oObjektimg = ActiveSheet.Shapes(1).Copy

 

I början av subben.

 

Längre ner, efter att alla objekt raderats la jag till:

 

.Range("I1").PasteSpecial.oObjektimg

 

Verkar fungera i alla fall.