Split Excel worksheet into multiple worksheets based on a column with VBA (Redux)
- by Ceeder
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!
