Split Excel worksheet into multiple worksheets based on a column with VBA (Redux)

Posted by Ceeder on Super User See other posts from Super User or by Ceeder
Published on 2014-06-12T21:00:43Z Indexed on 2014/06/12 21:28 UTC
Read the original article Hit count: 592

Filed under:
|

I'm rather new to VBA and I've been working with the code generously displayed and explained by Nixda:

Split Excel Worksheet...

My only challenge is I've been trying desperately to find a way to include the top 3 rows as a title bu it seems to only allow for one. Here's the code have:

Dim Titlesheet As Worksheet

iCol = 23 '### Define your criteria column strOutputFolder = (Sheets("Operations").Range("D4")) '### <--Define your path of output folder

Set ws = ThisWorkbook.ActiveSheet Set rngLast = Columns(iCol).Find("*", Cells(3, iCol), , , xlByColumns, xlPrevious) Set Titlesheet = Sheets("Input") ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True Set rngUnique = Range(Cells(4, iCol), rngLast).SpecialCells(xlCellTypeVisible)

If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder For Each strItem In rngUnique If strItem <> "" Then Sheets("Input").Select Range("A1:V3").Select Selection.Copy ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value Workbooks.Add Sheets("Sheet1").Select ActiveSheet.PasteSpecial ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=[A4] strFilename = strOutputFolder & "\" & strItem ActiveWorkbook.SaveAs Filename:=strFilename, FileFormat:=xlWorkbookNormal ActiveWorkbook.Close savechanges:=False End If Next ws.ShowAllData

Is there something I can change to include these lines?

Thanks so much, this code provided by Nixda has taught me a great deal!

© Super User or respective owner

Related posts about microsoft-excel-2010

Related posts about vba