Copy data to new workbooks based on cell value

[corndogs]

Hola

This is my first post but I've been to this site many times for useful information so thank you! In fact, the code below is based on some code I found here I believe.

My intention is to create x number of workbooks based on values in column k (RepAssign). X is precisely my hang up. I've been able to write code to filter by values in a column to copy the filtered data to a new workbook, however, the values were static in the past.

My new code is splitting out records evenly based on user input, a prompt asks the user how many ways to split the rows. For testing, I went with 3 so I'd like to end up with 3 new workbooks for example, leaving the original/source workbook as is. It could be anywhere from 2 to 20 workbooks being created, again depending on user input. See attached for sample data.

Existing code;

Please Login or Register  to view this content.

Thanks!

[bakerman2]

Hi corndogs, welcome to the forum.

Administrative Note:

We would very much like to help you with your query, however you need to include code tags around your code.

Please take a moment to add the tags. Posting code between [CODE]Please [url=https://www.excelforum.com/login.php]Login or Register [/url] to view this content.[/CODE] tags makes your code much easier to read and copy for testing, and it also maintains VBA formatting.

Please see Forum Rule #2 about code tags and adjust accordingly. Click on Edit to open your post, then highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

(Note: this change is not optional. No help to be offered until this moderation request has been fulfilled.)

[corndogs]

Sorry about that! I believe it's adjusted as requested

Thanks!

[Marc L]

According to your attachment as a beginner starter to paste to the (test) worksheet module :

Sub Demo1()
     Dim P$, R&
         P = ThisWorkbook.Path & Application.PathSeparator
         Application.DisplayAlerts = False
         Application.ScreenUpdating = False
    With Me.ListObjects(1).Range
           .Columns(11).AdvancedFilter xlFilterCopy, , [N1], True
        For R = 2 To [N1].CurrentRegion.Count
            Workbooks.Add
            [N2].Value2 = Cells(R, 14).Value2
           .AdvancedFilter xlFilterCopy, [N1:N2], ActiveSheet.[A1]
            ActiveWorkbook.SaveAs P & [N2].Value2, 51
            ActiveWorkbook.Close
        Next
    End With
         [N1].CurrentRegion.Clear
         Application.ScreenUpdating = True
         Application.DisplayAlerts = True
End Sub 

► Do you like it ? ► ► So thanks to click on bottom left star icon « ★ Add Reputation » !

[corndogs]

Hi Marc,

I'm getting a compile error on Me.ListObjects - 'Invalid use of Me keyword'. I've actually never used 'me' in my code so I'm lost. Is there a replacement I can use?

Thanks!
J

[bakerman2]

Did you put the code in the worksheet-module where the table resides ?

[corndogs]

Yes, I placed the code right below the 'End With' line.

Please Login or Register  to view this content.

[bakerman2]

That's not what I asked.

Right-click on the sheet tab where the table is on. Select View Code (now you are in the Sheet module). Paste Marc L's code in the right code window.

[corndogs]

I apologize for the misunderstanding. I store all my macros in one project, labeled ProvMacros. I created a new module for this code within the ProvMacros project named Split Assign and get the compile error. Then based on your feedback, I placed the code in a new the module within the workbook itself instead of the project I always use. I come up with the same compile error.

[bakerman2]

No, open Microsoft Excel Objects and double-click on the sheet where your table is on, then paste the code in the right window.

The code needs to be in a SHEET-module, not a module you create yourself.

[corndogs]

Thank you bakerman2.

This does work now but the problem is the source file will change weekly/daily. It wouldn't be ran it on the same file every time so having the code embedded in the spreadsheet won't work for my purposes.

I'm sure it's my lack of knowledge but my macros are set up as modules I created myself because it has to do with manipulating new files each instance. My intention is to have the end user, who has no knowledge of macros, open the file needing manipulation, then selecting the macro without doing anything in the VBA screen to execute.

Thanks

[Marc L]

So you will have same issue whatever the code is located …

[corndogs]

Well no, it does work when the code is added within the sheet, it's just not the ideal structure for the process we have set up. I was looking for an alternate piece of code to replace Me.ListObjects and in essence end up with the same results.

[Marc L]

'Me' is a reference to the worksheet where the code is, as you must have read in the VBA inner help …

[bakerman2]

Please disregard.

[Marc L]

Maybe an issue :

Please Login or Register  to view this content.

[bakerman2]

Yes, that's why I deleted my previous answer.

Have to find an other angle.

[Marc L]

Oh no, your previous answer was pretty good except for the red part which must stay as initialy written
'cause in my original codeline [N1:N2] without any sheet reference not refers to ActiveSheet but to the 'Me' worksheet
so ActiveSheet.[A1] must stay as it is as it refers to the new workbook, the destination of the copy …

[Marc L]

Instead of an easier / safer worksheet class module my revamped code for a general / standard module like 'Module1' :

Sub Demo1r()
         Dim R&
         Application.DisplayAlerts = False
         Application.ScreenUpdating = False
    With Sheet8.ListObjects(1).Range
           .Columns(11).AdvancedFilter xlFilterCopy, , .Range("N1"), True
        For R = 2 To .Range("N1").CurrentRegion.Count
            Workbooks.Add
           .Range("N2").Value2 = .Cells(R, 14).Value2
           .AdvancedFilter xlFilterCopy, .Range("N1:N2"), [A1]
            ActiveWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & .Range("N2").Value2, 51
            ActiveWorkbook.Close
        Next
           .Range("N1").CurrentRegion.Clear
    End With
         Application.ScreenUpdating = True
         Application.DisplayAlerts = True
End Sub 

Do you like it ? So thanks to click on bottom left star icon « ★ Add Reputation » !