Hi I have a large spreadsheet with headings in row 1. In column A are the product codes so for example in row 2 it might say ABC123 then there may be say 10 rows of data and in the other rows column A will be blank. Then in row 12 it may say BCD456 and so many rows of data etc.
What I need to do is at each change in row A I want a new tab creating with the data and want the headings from row 1 copying across. I would like tab name to be the product code for each of the tabs.
The next step is then to split out these tabs into separate workbooks and saved in a particular directory. The filename should be the tab name like ABC123, BCD456 etc.
Would appreciate some help with this please. Thanks
Attached is a fairly simple example which I believe will do what you're asking, short of saving each tab to its own workbook. Let me know if that's the case, and then I'll add in the part to save each tab.
Ok, I'll add in the splitting to separate workbooks piece later today. I have something for work that does the exact thing, so shouldn't take too long to find.
Sub splitToNew()
Dim objSFolders As Object
Dim j As Integer
Dim wbData As Workbook
Dim wbTemp As Workbook
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
strPath = objSFolders("mydocuments") & "\"
Set wbData = ActiveWorkbook
For j = 1 To wbData.Worksheets.Count
If LCase(wbData.Worksheets(j).Name) <> "master" Then 'don't save the original worksheet to a new workbook (change name as required)
wbData.Worksheets(j).Copy
Set wbTemp = ActiveWorkbook
fName = strPath & wbData.Worksheets(j).Name & ".xlsx"
On Error Resume Next
Kill fName
If Err.Number <> 0 Then
Err.Clear
End If
On Error Resume Next
wbTemp.SaveAs Filename:=fName
If Err.Number <> 0 Then
Err.Clear
MsgBox "couldn't save " & fName & vbCrLf & vbCrLf & "Exiting now..."
Exit Sub
End If
End If
Next j
End Sub
Hi...I tried the code and I get the error message couldn't save \sheet1.xlsx...Exiting now.
I am running the code in the example sheet you attached. Thanks
Hi...when I changed the sheet name to "master" I don't get the error message anymore.
I changed the save to folder to C:\SplitWS but the files are saving to the root C:\ rather than the SplitWS folder. Any ideas? This is the code
Code:
Sub splitToNew()
Dim objSFolders As Object
Dim j As Integer
Dim wbData As Workbook
Dim wbTemp As Workbook
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
strPath = objSFolders("C:\SplitWS") & "\"
Set wbData = ActiveWorkbook
For j = 1 To wbData.Worksheets.Count
If LCase(wbData.Worksheets(j).Name) <> "master" Then 'don't save the original worksheet to a new workbook (change name as required)
wbData.Worksheets(j).Copy
Set wbTemp = ActiveWorkbook
fName = strPath & wbData.Worksheets(j).Name & ".xlsx"
On Error Resume Next
Kill fName
If Err.Number <> 0 Then
Err.Clear
End If
On Error Resume Next
wbTemp.SaveAs Filename:=fName
If Err.Number <> 0 Then
Err.Clear
MsgBox "couldn't save " & fName & vbCrLf & vbCrLf & "Exiting now..."
Exit Sub
End If
End If
Next j
End Sub
Set objSFolders = CreateObject("WScript.Shell").SpecialFolders
strPath = objSFolders("C:\SplitWS") & "\"
splitWS is not a specialfolder, so strpath becomes \ only, no need now for wscript.shell
change to
Code:
strpath = "C:\SplitWS\"
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case. Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete