Spara kalkylblad som fil med VBA

En återkommande fråga som vi ofta får är hur man skriver ett makro för att spara kalkylblad som fil (separata filer per kalkylblad). Koden nedan gör just detta. VBA-koden går igenom samtliga ark och granskar deras namn. Om namnet inte är Blad1 så sparas arket som en separat fil. (Du kan självklart ta bort denna del eller ändra Blad1 till ett annat bladnamn). Att vi inte sparar Blad1 är bara ett exempel på hur man kan skriva om man inte vill spara ett visst blad. Fler varianter finns givetvis. Vill du lära dig hantera detta och mycket mer är du varmt välkommen på tvådagarskursen VBA & makron. Du gör anmälan på infocell.se.

Koden ger filen samma namn som arket och lägger den i samma mapp som originalfilen. Om en fil med samma namn redan finns så får man frågan om man vill spara över den.

Testa gärna makrot (och kopiera koden) i filen SparaBladflikarSomEgnaFiler.xlsm.

I filen finns sex olika bladflikar och när makrot körs skapas en ny fil för varje bladflik i samma mapp som filen tillhör.

VBA-kod för att spara varje blad som fil

Nedan ser du koden för att spara kalkylblad som fil.

Public Sub SparaBladflikar()

    Dim ark As Worksheet

    Dim wbNyArbetsbok As Workbook


    ' Gå igenom alla ark i arbetsboken
    ' skapat av Excelbrevet.se och Infocell AB

    For Each ark In ThisWorkbook.Sheets

        ' Blad1 vill vi inte spara ut, men alla andra ark

        If ark.Name <> "Blad1" Then ' om arkets namn inte är Blad1

            ' Kopiera arket, innebär att ny fil skapas med det aktuella arket

            ark.Copy

            ' Det nya arbetsboken blir automatiskt den aktiverade arbetsboken

            ' vi låter wbNyArbetsbok peka på den nya boken

            Set wbNyArbetsbok = ActiveWorkbook

            ' Vi sparar den i samma mapp som originalfilen ("ThisWorkbook.Path & "\")
            ' och lägger på arknamet som namn på filen samt filändelsen ".xlsx"

            wbNyArbetsbok.SaveAs (ThisWorkbook.Path & "\" & ark.Name & ".xlsx")

            ' vi stänger den

            wbNyArbetsbok.Close

        End If

        ' Vi går vidare till nästa ark,dvs går upp

        ' och upprepar for så länge det finns ark kvar

    Next

End Sub