LinkBack URL
About LinkBacks
I have 100 worksheets in a file. I need to export every 4 worksheets into a seperate file so I have a total of 25 new files.
I have 100 worksheets in a file. I need to export every 4 worksheets into a seperate file so I have a total of 25 new files.
Maybe:
Sub Sgligori() Dim i As Long Dim wbkOrig As Workbook, wbkDest As Workbook Set wbkOrig = ActiveWorkbook Workbooks.Add ActiveWorkbook.SaveAs "New File" & ".xlsx" Set wbkDest = Workbooks("New File.xlsx") With wbkOrig For i = 1 To 100 Step 4 .Sheets(i).Copy After:=wbkDest(Sheets.Count) Next i End With End Sub
The code above exports each worksheet as new file, not every 4 worksheets.
The code provided was untested and it actually error'd out for me. However I revised it. See if this helps.
BTW it does copy to a new workbook.Sub Sgligori() Dim i As Long Dim wbkOrig As Workbook, wbkDest As Workbook Set wbkOrig = ActiveWorkbook Workbooks.Add ActiveWorkbook.SaveAs "New File" & ".xlsx" Set wbkDest = Workbooks("New File.xlsx") wbkOrig.Activate For i = 100 To 4 Step -4 wbkOrig.Sheets(i).Copy After:=wbkDest.Sheets(wbkDest.Sheets.Count) wbkOrig.Activate Next i End Sub
Give a chance to next code
The macro is hosted in the file attached and can be used as a toolbox
The original file (with data )must be loaded in Excel, its name is "OrgFile.xlsx" : Adapt it to your need
All files prepared are recorded in the same folder as the toolbox (active file) and are named "DestFile" plus an index. If there is some files with the same name they are replaced by the new file.
Option Explicit Sub Treat() Dim OrgFile As Workbook Dim DestFile As Workbook Const OrgFileName As String = "OrgFile.xlsx" Const DestFileName As String = "DestFile" Dim WkPath As String Dim WS As Worksheet Dim i As Integer Dim II As Integer Set OrgFile = Workbooks(OrgFileName) WkPath = ActiveWorkbook.Path & "\" With OrgFile For i = 1 To .Worksheets.Count Step 4 Workbooks.Add .Sheets(i).Copy Before:=Sheets(1) Application.DisplayAlerts = False For II = 2 To Sheets.Count Sheets(II).Delete Next ActiveWorkbook.SaveAs WkPath & DestFileName & i & ".xlsx" ActiveWorkbook.Close Application.DisplayAlerts = True Next End With End Sub
Last edited by PCI; 07-21-2015 at 03:20 PM. Reason: additional info added
- Battle without fear gives no glory - Just try
I tried both macros on my data. Neither one worked.
Did you activate the original workbook (source) before you ran the macro? What happens when you run the codes? Are the sheets names different? They need to be.
I've attached a sample file with 9 tabs. Ideally, the macro would have created 3 new files (File 1 with tabs Jan14-Aprl14 only, File 2 wih Jan15-Apr15 tabs only,File 3 with only Jan16). The result is attached. It inserted "Sheet 1" and copied every 4th tab.
It means it did not run with file sent: PrepareFile.xlsm ???
Maybe:
Sub Sgligori() Dim i As Long, y As Long, ws As Worksheet Dim wbkOrig As Workbook, wbkDest As Workbook Set wbkOrig = ActiveWorkbook y = 1 wbkOrig.Activate For i = 1 To wbkOrig.Sheets.Count + 4 Step 4 Workbooks.Add ActiveWorkbook.SaveAs "New File" & y & ".xlsx" Set wbkDest = Workbooks("New File" & y & ".xlsx") y = y + 1 On Error Resume Next For Each ws In wbkOrig.Sheets(Array("" & wbkOrig.Sheets(i).Name & "", "" & wbkOrig.Sheets(i + 1).Name & "", "" & wbkOrig.Sheets(i + 2).Name & "", "" & wbkOrig.Sheets(i + 3).Name & "")) ws.Copy after:=wbkDest.Sheets(wbkDest.Sheets.Count) Next ws wbkOrig.Activate Next i End Sub
John- that works. Thank you.
PCI- that's correct. It did not run with file.
You're welcome. Glad to help out and thanks for the feedback.
There are currently 1 users browsing this thread. (0 members and 1 guests)
Posting Permissions
Register To Reply
Bookmarks