Split sheets into different files based on criteria

Learner1983

New Member
Joined
Apr 12, 2013
Messages
5
Hi There

I am new to writing macros. I am trying to write a macro which will split the sheets (2 or 3) into different files. I have the Index file where i have gropued the sheets (A1:B23) into file names and from A32:A39 i have mentioned the files to be created.

below is untested macro and i am getting error in Do while row

Option Explicit
Public iCurrentRow, iCurrentCol
Public SupportSheet
Sub split_files()
Dim StrCurrentText As String
Dim strdir As String
Dim rng, r As Range
'Dim iCurrentRow, iCurrentCol
strdir = "C:\Macro_Files"
iCurrentRow = 32
iCurrentCol = 1
Set SupportSheet = Worksheets("Index")
SupportSheet.Cells(iCurrentRow, iCurrentCol).Select
StrCurrentText = SupportSheet.Cells(iCurrentRow, iCurrentCol)
Do While SupportSheet.Cells(StrCurrentText) <> ""
'SupportSheet.Select
SupportSheet.Range("B1").AutoFilter field:=2, Criteria1:=Cells(StrCurrentText).Value
Set rng = SupportSheet.AutoFilter.Range
Set r = SupportSheet.AutoFilter.Range
For Each r In rng
Worksheets(r).Copy
ActiveWorkbook.SaveAs Filename:=strdir + StrCurrentText + ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close

Next

iCurrentRow = iCurrentRow + 1
StrCurrentText = SupportSheet.Cells(iCurrentRow, iCurrentCol)
Loop

End Sub

Please Help
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Hi,
I think your error is the result of duplication.
Try:
StrCurrentText = SupportSheet.Cells(iCurrentRow, iCurrentCol).value
Do While StrCurrentText <> ""
 
Upvote 0
Thanks DeBeuz for your quick reply. I was able to move on from that error. Now there is a real challenge for me. after filtering the data i want use the A column data (sheets names) to move the selected sheets to new file. Can you please give me some guidance

Do While StrCurrentText <> ""
'SupportSheet.Select
SupportSheet.Range("B1").AutoFilter field:=2, Criteria1:=StrCurrentText
Set rng = SupportSheet.AutoFilter.Range
Set r = SupportSheet.AutoFilter.Cells("A:A")
For Each r In rng
Worksheets(r).Copy
ActiveWorkbook.SaveAs Filename:=strdir + StrCurrentText + ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close

Next

iCurrentRow = iCurrentRow + 1
StrCurrentText = SupportSheet.Cells(iCurrentRow, iCurrentCol)
Loop
 
Upvote 0
Thanks DeBeuz for your quick reply. I was able to move on from that error. Now there is a real challenge for me. after filtering the data i want use the A column data (sheets names) to move the selected sheets to new file. Can you please give me some guidance

Do While StrCurrentText <> ""
'SupportSheet.Select
SupportSheet.Range("B1").AutoFilter field:=2, Criteria1:=StrCurrentText
Set rng = SupportSheet.AutoFilter.Range
Set r = SupportSheet.AutoFilter.Cells("A:A")
For Each r In rng
Worksheets(r).Copy
ActiveWorkbook.SaveAs Filename:=strdir + StrCurrentText + ".xlsx", FileFormat:=xlOpenXMLWorkbook
ActiveWindow.Close

Next

iCurrentRow = iCurrentRow + 1
StrCurrentText = SupportSheet.Cells(iCurrentRow, iCurrentCol)
Loop
 
Upvote 0
Hi,

Can you show me some of the contents?
I have trouble understanding what your data looks like.
Also an example from one of the rows of what you want to be done should help.

Regards,

Paul
 
Upvote 0
Hi

I have 10 working sheets and 7 summary sheets in one file. I am looking to split these into 7 files. Files will have one summary sheet and one or more working sheets.

I have added the Index sheet where i have made one table where every sheet name is mentioned in A column and i have mentioned new file name in column B. From row number A27 i have mentioned the file names which needs to be generated. I couldnt attach excel file and hence attached image of index sheet. Let me know your email id for me to send the excel file


Regards
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,207
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top