Skapa separata arbetsböcker av varje flik

Makroexempel i VBA som på ett enkelt sätt splittar upp arbetsböcker till separata filer vilka  automatiskt spars på samma ställe som ursprungsboken.

Detta kan vara praktiskt för rapporter som du skapar i Excel och som till exempel innehåller en avdelning av företaget per flik. När du väl skall skicka ut inormationen till berörda så kanske du inte vill belasta mottagaren med samtliga flikar i rapporten utan bara just dennes avdelning.

Detta kan man lösa för hand genom att manuellt kopiera flik för flik till nya arbetsböcker. Om det handlar om en stor mängd flikar, liksom om ett periodvis återkommande arbetsmoment, så kan man överväga att skapa en makro för uppgiften.

VBA-kod som skapar separat Excelfil av varje blad

Programmet loopar igenom samtliga arbetsblad från och med det ordningsnummer som du anger överst i koden. I exemplet ovan så börjar loopen på 2, dvs den hoppar över det kalkylblad som ligger längst till vänster i arbetsboken.

Vidare så kopieras varje flik till en ny Excelbok som spars på samma ställe som den arbetsbok där det här programmet ligger i. Den nya Excelboken får samma namn som motsvarande flik. Ett tips är således att innan makrokörningen kopiera den ursprungliga Excelfilen till en ny, tom folder och sedan köra makrot därifrån. På det sättet så undviker du krockar vad gäller filnamn samt inte minst så slipper du problem med överskrivna filer.

Sub Skapa_Ny_Fil_Av_Varje_Flik()
 
Dim i As Integer
Dim strBladnamn As String
Dim strSokVag As String
Dim FilNamn As String
 
For i = 2 To Sheets.Count 't ex 1 flik innan dest-flikarna börjar
Sheets(i).Activate  strBladnamn = ActiveCell.Worksheet.Name
Sheets(strBladnamn).Select
 
'Kopierar varje blad till en ny arbetsbok
Sheets(strBladnamn).Copy
strSokVag = ThisWorkbook.Path
ChDir strSokVag
FilNamn = strBladnamn
 
'Spar ned den nya arbetsboken på samma ställe som grundfilen
ActiveWorkbook.SaveAs Filename:=strSokVag & "/" & FilNamn, _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
ReadOnlyRecommended:=False, CreateBackup:=False
 
'Stänger ned den nyskapade Excelfilen
ActiveWindow.Close Savechanges:=True
 
Next
 
End Sub