Hello,
Running Excel 2016 on PC
I have been browsing the internet for a few weeks trying to figure this out and I am stuck. I was tasked to take an existing master file with multiple worksheets and split the workbook retaining the worksheets but only show the data for each individual sales rep (over 1000 in our workforce which makes this manual task a huge burden). The master workbook consists of 3 worksheets.
I currently have code written and working that takes the master workbook and splits out the worksheet I have designated for each individual sales rep in our organization and saves the worksheet as a unique file name (code listed below as sub SplitToFiles) which I then run for each worksheet in the master file. I would imagine there is some way to loop the initial code is it is written from the get go to split the file for each worksheet and save it as one workbook but I haven't been able to figure this out which is why I went the route of looking for a solution of splitting and then recombining.
Now where I am stuck is getting the new worksheets for the individual rep into a combined file of 1 workbook with all of the worksheets for this rep only. The code I was been able to put together will combine all files in a folder thus defeating my breakout efforts (code listed below as sub getsheets).
I would greatly appreciate anyone's help with pointing out where I've gone wrong with this/these codes. I really want to learn!
----------------------------------------------------------------------------
--------------------------------------------------------------------------
Running Excel 2016 on PC
I have been browsing the internet for a few weeks trying to figure this out and I am stuck. I was tasked to take an existing master file with multiple worksheets and split the workbook retaining the worksheets but only show the data for each individual sales rep (over 1000 in our workforce which makes this manual task a huge burden). The master workbook consists of 3 worksheets.
I currently have code written and working that takes the master workbook and splits out the worksheet I have designated for each individual sales rep in our organization and saves the worksheet as a unique file name (code listed below as sub SplitToFiles) which I then run for each worksheet in the master file. I would imagine there is some way to loop the initial code is it is written from the get go to split the file for each worksheet and save it as one workbook but I haven't been able to figure this out which is why I went the route of looking for a solution of splitting and then recombining.
Now where I am stuck is getting the new worksheets for the individual rep into a combined file of 1 workbook with all of the worksheets for this rep only. The code I was been able to put together will combine all files in a folder thus defeating my breakout efforts (code listed below as sub getsheets).
I would greatly appreciate anyone's help with pointing out where I've gone wrong with this/these codes. I really want to learn!
----------------------------------------------------------------------------
Public Sub SplitToFiles()
Dim osh As Worksheet
Dim iRow As Long
Dim iCol As Long
Dim iFirstRow As Long
Dim iTotalRows As Long
Dim iStartRow As Long
Dim iStopRow As Long
Dim sSectionName As String
Dim rCell As Range
Dim owb As Workbook
Dim sFilePath As String
Dim iCount As Integer
iCol = Application.InputBox("Enter the column number used for splitting", "Select column", 2, , , , , 1) 'The starting column position varies from worksheet to worksheet
iRow = Application.InputBox("Enter the starting row number (to skip header)", "Select row", 5, , , , , 1) 'The starting row position varies from worksheet to worksheet
iFirstRow = iRow
Set osh = Workbooks("Master Workbook.xlsm").Worksheets(1) 'Worksheet number is updated to 2 and 3 to be run for each worksheet on the master workbook.
Set owb = Application.ActiveWorkbook
iTotalRows = osh.UsedRange.Rows.Count
sFilePath = Application.ActiveWorkbook.Path
If Dir(sFilePath + "\Split", vbDirectory) = "" Then
MkDir sFilePath + "\Split"
End If
Application.EnableEvents = False
Application.ScreenUpdating = False
Do
Set rCell = osh.Cells(iRow, iCol)
sCell = Replace(rCell.Text, " ", "")
If sCell = "" Or (rCell.Text = sSectionName And iStartRow <> 0) Or InStr(1, rCell.Text, "total", vbTextCompare) <> 0 Then
Else
If iStartRow = 0 Then
sSectionName = rCell.Text
iStartRow = iRow
Else
iStopRow = iRow - 1
CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
iCount = iCount + 1
iStartRow = 0
iStopRow = 0
iRow = iRow - 1
End If
End If
If iRow < iTotalRows Then
iRow = iRow + 1
Else
iStopRow = iRow
CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat
iCount = iCount + 1
Exit Do
End If
Loop
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Public Sub DeleteRows(targetSheet As Worksheet, RowFrom As Long, RowTo As Long)
Dim rngRange As Range
Set rngRange = Range(targetSheet.Cells(RowFrom, 1), targetSheet.Cells(RowTo, 1)).EntireRow
rngRange.Select
rngRange.Delete
End Sub
Public Sub CopySheet(osh As Worksheet, iFirstRow As Long, iStartRow As Long, iStopRow As Long, iTotalRows As Long, sFilePath As String, sSectionName As String, fileFormat As XlFileFormat)
Dim ash As Worksheet
Dim awb As Workbook
osh.Copy
Set ash = Application.ActiveSheet
If iTotalRows > iStopRow Then
DeleteRows ash, iStopRow + 1, iTotalRows
End If
If iStartRow > iFirstRow Then
DeleteRows ash, iFirstRow, iStartRow - 1
End If
ash.Cells(1, 1).Select
sSectionName = Replace(sSectionName, "/", " ")
sSectionName = Replace(sSectionName, "", " ")
sSectionName = Replace(sSectionName, ":", " ")
sSectionName = Replace(sSectionName, "=", " ")
sSectionName = Replace(sSectionName, "*", " ")
sSectionName = Replace(sSectionName, ".", " ")
sSectionName = Replace(sSectionName, "?", " ")
ash.SaveAs sFilePath + "\Split" + "Order Report " + sSectionName, fileFormat
Set awb = ash.Parent
awb.Close SaveChanges:=False
End Sub
--------------------------------------------------------------------------
Sub getsheets()
Path = "C:\Users\Jessica\Desktop\Split"
Filename = Dir(Path & "*.xlsm")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True
For Each Sheet In ActiveWorkbook.Sheets
Sheet.Copy After:=ThisWorkbook.Sheets(1)
Next Sheet
Workbooks(Filename).Close
Filename = Dir()
Loop
End Sub
