Saving multiple Excel files based on a list

Solved/Closed
KenthH
Posts
3
Registration date
Thursday September 13, 2018
Status
Member
Last seen
September 20, 2018
- Updated on Nov 4, 2018 at 03:55 AM
KenthH
Posts
3
Registration date
Thursday September 13, 2018
Status
Member
Last seen
September 20, 2018
- Sep 20, 2018 at 04:03 PM
Hi,

I'm totally new to writing macros in excel but I thought I'd give it a go. I've seen similar threads but I can't find the answer to my problem. I want to save the content of a tab, "Master" to a new file based on a list of names in another tab, "Names". I want the filename and the name of the tab in the new file to be named according to the list.

I have based the code on two examples from @TrowaD but I cannot get it to loop correctly. It succeeds the first time but then it gets stuck on
Sheets("Master").Range("A1").CurrentRegion.Copy
according to the debugger. Error message : Run-time error 9, Subscript out of range. It also opens the newly created file which I would like to avoid if possible.

Any help on this would be very welcome!


Sub SplitData()

Dim wbName As String
Dim lRow, x As Integer

lRow = Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row
x = 0

Do
x = x + 1
wbName = Sheets("Names").Range("A" & x)
Sheets("Master").Range("A1").CurrentRegion.Copy
Workbooks.Add
Worksheets.Add
ActiveSheet.Name = wbName
Range("A1").PasteSpecial
ActiveWorkbook.SaveAs Filename:="/Users/kenth/Documents/exceltest/" & wbName & ".xls"
Application.CutCopyMode = False
Loop Until x = lRow

End Sub


Best regards,
KenthH
Related:

2 replies

TrowaD
Posts
2888
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 16, 2022
515
Sep 13, 2018 at 11:52 AM
Hi KenthH,
-
  • The error you get happens because the newly added workbook isn't closed and doesn't contain a sheet named "Master". This is solved with the point below.
  • To prevent having to close all the newly created workbooks, I added a line to close them for you.
  • Your path "/Users/kenth/Documents/exceltest/" doesn't have a station letter and contains forward slashes instead of backward. But you didn't mention this, so I guess it's just a sample path.

Here is the amended code:
Sub SplitData()
Dim wbName As String
Dim lRow, x As Integer

lRow = Sheets("Names").Range("A" & Rows.Count).End(xlUp).Row

Do
    x = x + 1
    wbName = Sheets("Names").Range("A" & x)
    Sheets("Master").Range("A1").CurrentRegion.Copy
    Workbooks.Add
    Worksheets.Add
    ActiveSheet.Name = wbName
    Range("A1").PasteSpecial
    With ActiveWorkbook
        .SaveAs Filename:="C:\MyFiles\" & wbName & ".xls"
        .Close
    End With
Loop Until x = lRow

Application.CutCopyMode = False
End Sub


How does the code perform now?

Best regards,
Trowa
0
KenthH
Posts
3
Registration date
Thursday September 13, 2018
Status
Member
Last seen
September 20, 2018

Sep 14, 2018 at 05:03 AM
Hi Trowa,

thanks!! The loop works now. The only problem I have now is the path. I'm on Mac and I thought it should work to have a linux-style path, but as it is right now it includes the path in the actual filename. If I leave the path out I get the correct files in the directory where I started excel so that's a quick workaround. But if you have suggestions for the correct definition and use of the path on Mac that would be great.

Thanks again!! So helpful!!

Best regards,
Kenth
0
TrowaD
Posts
2888
Registration date
Sunday September 12, 2010
Status
Moderator
Last seen
August 16, 2022
515
Sep 17, 2018 at 11:54 AM
Hi Kenth,

I don't have acces to a Mac, so I can't test my suggestion.

It seems that for Excel 2011 the path needs to be:
Macintosh HD:Users:RDB:Desktop:YourFolder:
And for Excel 2016:
/Users/RDB/Desktop/YourFolder/

It also seems that Mac doesn't need file extention (which seems very weird to me).

Looking at your first post I would change code line 16:
.SaveAs Filename:="C:\MyFiles\" & wbName & ".xls"
into:
.SaveAs Filename:="/Users/kenth/Documents/exceltest/" & wbName

Hopefully that solves it for you.

Best regards,
Trowa


0
KenthH
Posts
3
Registration date
Thursday September 13, 2018
Status
Member
Last seen
September 20, 2018

Sep 20, 2018 at 04:03 PM
Hi Trowa,

it works beautifully now, thank you so much for helping me out!

Best regards,
Kenth
0