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 i Stockholm City 29-30 maj (2 platser kvar). 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. (ibland kan det vara problem att kopiera kod från webbläsare, så öppna filen ovan och kopiera koden från filen för att eliminera detta potentiella problem).
Public Sub SaveSheets()
Dim ark As Worksheet
Dim wbNyArbetsbok As Workbook
‘ Gå igenom alla ark i arbetsboken
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
