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
microsoft-excel-2010
|vba
I'm rather new to VBA and I've been working with the code generously displayed and explained by Nixda:
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