Infocell
 
 
 
 
 
 

SKAPA FLIKAR FRÅN SIDFÄLT I PIVOTTABELL & SKAPA FILER FRÅN FLIKARNA.

 

Grunddata: Varje månad får försäljningschefen för företaget ut en lista över varje försäljningen per land och marknad och per säljare/person.

Övningsfilen med nedanstående data finns att hämta hem HÄR.

pivot

Målsättning 1: Försäljningschefen vill sedan sammanställa denna information per land där säljarens namn finns med tillsammans med försäljningsbelopp och täckningsbidrag. (Listan kunde lika gärna bestå av 100 namn och 50.000 rader istället för ett fåtal som i exemplet. Antalet kolumner med information kunde givetvis vara betydligt mer komplex).

 

Målsättning 2: Försäljningschefen vill sedan effektivt distribuera informationen till de olika marknadscheferna (en chef per marknad  - i exemplet 4 st). Viktigt är att de inte får se data för varandras marknader.

 

MÅLSÄTTNING 1:
Vi uppfyller denna målsättning genom att ha markören i tabellen och via menyn Infoga väljer vi knappen pivottabell och väljer i exemplet att placera pivottabellen ”På detta kalkylblad” och väljer cellen ”I1”.  Vi drar fältet Marknad till Rapportfilter, fälten Land, Förnamn och Efternamn till Radetiketter och slutligen placerar Försäljning och TB1 som Värden.
Pivottabellen har layouten: Verktyg för pivottabell – Design – Rapportlayout – Visa i tabellformat.
Pivottabellen har formatet: Verktyg för pivottabell – Design – Pivottabellformat välj ”Mellanmörkt pivottabellformat9”.

pivot

MÅLSÄTTNING 2:
Steg 1:
Vi har nu valt att sätta ”Marknad” som Rapportfilter/sidfält. Detta möjliggör att vi enkelt i Excel kan bryta ut varje ”Marknad” (Skandianvien, Nordeuropa, Mellaneuropa och Sydeuropa) och automatskapa en flik och pivottabell för varje markand genom att göra:

1 Stå i pivottabellen med markören. Via menyer Verktyg för pivottabell och Alternativ väljer vi Alternativ i menyfliksområdet Pivottabell (längst till vänster). Klicka på Visa rapportfiltersidor.
pivot
2 Klicka sedan OK på nästa pop-up. Du ser nu att en flik för varje Marknad har skapats med en pivottabell enligt samma uppställningen som den ursprungliga.

 

Steg 2:
Nu vill vi spara varje flik som en separat fil för att kunna distribuera ut informationen till respektive marknadschef.

Gå in i VBA-editorn via menyn Utvecklare och klicka på Visual Basic.

pivot

När ni kommer in i VBA-editorn, dubbelklicka på ThisWorkbook (markerat nedan) och detta fönster öppnar sig då. Klistra in VBA-koden som ligger placerad längst ner i detta dokument.

pivot

Klicka sedan på spela-makro-knappen (markerad ovan). Detta innebär att makrot körs. Det som nu händer är att varje flik i Excelfilen sparas som en egna Excelfiler. Dessa sparas i en undermapp till den mapp där huvudfilen är sparad. Mappen döps till samma namn som huvudfilen.

Nu kan vi enkelt välja att skicka iväg filerna till de olika marknadscheferna.

Nedan följer VBA-koden du ska klistra in i ThisWorkbook.

 

Sub Copy_Every_Sheet_To_New_Workbook()

'Working in 97-2010

    Dim FileExtStr As String

    Dim FileFormatNum As Long

    Dim Sourcewb As Workbook

    Dim Destwb As Workbook

    Dim sh As Worksheet

    Dim DateString As String

    Dim FolderName As String

 

    With Application

        .ScreenUpdating = False

        .EnableEvents = False

        .Calculation = xlCalculationManual

    End With

 

    'Copy every sheet from the workbook with this macro

    Set Sourcewb = ThisWorkbook

 

    'Create new folder to save the new files in

    DateString = Format(Now, "yyyy-mm-dd hh-mm-ss")

    FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString

    MkDir FolderName

 

    'Copy every visible sheet to a new workbook

    For Each sh In Sourcewb.Worksheets

 

        'If the sheet is visible then copy it to a new workbook

        If sh.Visible = -1 Then

            sh.Copy

 

            'Set Destwb to the new workbook

            Set Destwb = ActiveWorkbook

 

            'Determine the Excel version and file extension/format

            With Destwb

                If Val(Application.Version) < 12 Then

                    'You use Excel 97-2003

                    FileExtStr = ".xls": FileFormatNum = -4143

                Else

                    'You use Excel 2007-2010

                    If Sourcewb.Name = .Name Then

                        MsgBox "Your answer is NO in the security dialog"

                        GoTo GoToNextSheet

                    Else

                        Select Case Sourcewb.FileFormat

                        Case 51: FileExtStr = ".xlsx": FileFormatNum = 51

                        Case 52:

                            If .HasVBProject Then

                                FileExtStr = ".xlsm": FileFormatNum = 52

                            Else

                                FileExtStr = ".xlsx": FileFormatNum = 51

                            End If

                        Case 56: FileExtStr = ".xls": FileFormatNum = 56

                        Case Else: FileExtStr = ".xlsb": FileFormatNum = 50

                        End Select

                    End If

                End If

            End With

 

            'Change all cells in the worksheet to values if you want

            If Destwb.Sheets(1).ProtectContents = False Then

                With Destwb.Sheets(1).UsedRange

                    .Cells.Copy

                    .Cells.PasteSpecial xlPasteValues

                    .Cells(1).Select

                End With

                Application.CutCopyMode = False

            End If

 

 

            'Save the new workbook and close it

            With Destwb

                .SaveAs FolderName _

                      & "\" & Destwb.Sheets(1).Name & FileExtStr, _

                        FileFormat:=FileFormatNum

                .Close False

            End With

 

        End If

GoToNextSheet:

    Next sh

 

    MsgBox "You can find the files in " & FolderName

 

    With Application

        .ScreenUpdating = True

        .EnableEvents = True

        .Calculation = xlCalculationAutomatic

    End With

End Sub

 

www.infocell.se

Dela på Facebook Dela på MySpace Dela på Pusha Dela på Twitter