Ophi
03-03-2017, 07:52 AM
Hello
I am trying to create a macro to take data from a worksheet and create and save separate workbooks based upon unique values in a specific column. I found some code which I managed to modify, (with help), and it gets to the point of creating the first workbook but it hangs on the SaveAs. I have tried researching file formats, etc., and changing the location where it saves but I am still getting this "Run-time error '1004': Method 'SaveAs' of object'_Workbook' failed" error at this line: wb.SaveAs ThisWorkbook.Path & "C:\Users\burls5\Desktop\Created Files" & c.Value & ".xlsx"
Advice appreciated.
Sub splitCUbycolumn()
Dim wb As Workbook, sh As Worksheet, ssh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, "M").End(xlUp).Row
lc = sh.Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column
sh.Range("A" & lr + 2).CurrentRegion.Clear
sh.Range("M1:M" & lr).AdvancedFilter xlFilterCopy, , sh.Range("A" & lr + 2), True
Set rng = sh.Range("A" & lr + 3, sh.Cells(Rows.Count, 1).End(xlUp))
For Each c In rng
Set wb = Workbooks.Add
Set ssh = wb.Sheets(1)
ssh.Name = c.Value
sh.Range("A1", sh.Cells(lr, lc)).AutoFilter 12, c.Value
sh.Range("A1", sh.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ssh.Range("A1")
sh.AutoFilterMode = False
wb.SaveAs ThisWorkbook.Path & "C:\Users\burls5\Desktop\Created Files" & c.Value & ".xlsx"
wb.Close False
Set wb = Nothing
Next
sh.Range("A" & lr + 2, sh.Cells(Rows.Count, 1).End(xlUp)).Delete
End Sub
I am trying to create a macro to take data from a worksheet and create and save separate workbooks based upon unique values in a specific column. I found some code which I managed to modify, (with help), and it gets to the point of creating the first workbook but it hangs on the SaveAs. I have tried researching file formats, etc., and changing the location where it saves but I am still getting this "Run-time error '1004': Method 'SaveAs' of object'_Workbook' failed" error at this line: wb.SaveAs ThisWorkbook.Path & "C:\Users\burls5\Desktop\Created Files" & c.Value & ".xlsx"
Advice appreciated.
Sub splitCUbycolumn()
Dim wb As Workbook, sh As Worksheet, ssh As Worksheet, lr As Long, rng As Range, c As Range, lc As Long
Set sh = Sheets(1)
lr = sh.Cells(Rows.Count, "M").End(xlUp).Row
lc = sh.Cells.Find("*", , xlFormulas, xlPart, xlByColumns, xlPrevious).Column
sh.Range("A" & lr + 2).CurrentRegion.Clear
sh.Range("M1:M" & lr).AdvancedFilter xlFilterCopy, , sh.Range("A" & lr + 2), True
Set rng = sh.Range("A" & lr + 3, sh.Cells(Rows.Count, 1).End(xlUp))
For Each c In rng
Set wb = Workbooks.Add
Set ssh = wb.Sheets(1)
ssh.Name = c.Value
sh.Range("A1", sh.Cells(lr, lc)).AutoFilter 12, c.Value
sh.Range("A1", sh.Cells(lr, lc)).SpecialCells(xlCellTypeVisible).Copy ssh.Range("A1")
sh.AutoFilterMode = False
wb.SaveAs ThisWorkbook.Path & "C:\Users\burls5\Desktop\Created Files" & c.Value & ".xlsx"
wb.Close False
Set wb = Nothing
Next
sh.Range("A" & lr + 2, sh.Cells(Rows.Count, 1).End(xlUp)).Delete
End Sub