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 |