Add code to my current split macro to pull in first 25 rows

[ninjabik2001]

Hello,

I have a macro that splits one workbook into multiple based on column A (The provider). I want only the first 25 rows or less of that provider and some have less than 25 and others have over 200. I tried a count and still can't figure out the exact code. Im a newby somewhat to VBA so please bear w me. This is my spilt macro code. Any help would be appreciated. Thanks

Sub RosterSplit()
'This version copies entire sheet and then removes unwanted rows


Application.ScreenUpdating = False
Application.DisplayAlerts = False


iCol = 1 '### Define your criteria column
strOutputFolder = "S:\dept\PCP Quality\2019\Mike Split Folder"
Set ws = ThisWorkbook.ActiveSheet
Set rngLast = Columns(iCol).Find("*", Cells(1, iCol), , , xlByColumns, xlPrevious)
ws.Columns(iCol).AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set rngUnique = Range(Cells(2, iCol), rngLast).SpecialCells(xlCellTypeVisible)




If Dir(strOutputFolder, vbDirectory) = vbNullString Then MkDir strOutputFolder
For Each strItem In rngUnique
If strItem <> "" Then

ws.Copy

'If TypeName(ActiveSheet.AutoFilter) = "AutoFilter" Or ActiveSheet.AutoFilterMode Then
ActiveSheet.Range("A1").AutoFilter 'Turn off AutoFilter
'End If

ActiveSheet.Cells.ClearContents
ActiveSheet.Rows.Hidden = False


ws.UsedRange.AutoFilter Field:=iCol, Criteria1:=strItem.Value
ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("a1")

ActiveSheet.PageSetup.PrintArea = "$a1:$K$" & Cells(Rows.Count, "A").End(xlUp).Row '# Make sure to change to last column
'ActiveSheet.Range("A2").Activate
ActiveSheet.Range("A2").Select
ActiveWindow.LargeScroll down:=-1
strfilename = strOutputFolder & "" & strItem
ActiveWorkbook.SaveAs Filename:=strfilename, FileFormat:=51
ActiveWorkbook.Close savechanges:=False
End If
Next
ws.ShowAllData


Application.ScreenUpdating = True
Application.DisplayAlerts = True


End Sub

 

[Fluff]

Try adding this line

Ws.UsedRange.SpecialCells(xlCellTypeVisible).Copy Destination:=ActiveSheet.Range("a1")
[COLOR=#0000ff]ActiveSheet.Rows("27:" & Rows.Count).Delete[/COLOR]

 

[ninjabik2001]

Thank you so much!!!! Seems to work perfectly! I was overthinking it completely... You are the man!

 

[Fluff]

You're welcome & thanks for the feedback