Automatically split accounts Num

vask0

New Member
Joined
Mar 1, 2018
Messages
13
Hello I want to ask some have an idea..? how can i split these numbers automatically from the picture? with a script or no other idea ..

The idea is not to remove them manually one by one.

The idea is not to manually pull them out one by one, that sometimes there are a lot of accounts, and I have to download them manually and save them, thus hitting a lot of time. If there is any option at the end of it all will happen automatically or I will be more than happy to share a trick or a forum to do this thing ..

10!!!

accounts.png
 
that is, the name of the excel file.. that is, as I have named the excel file.?
No it's the sheet name not the file name.

because I want to scatter them to different files and not to sheeat...
Lets worry about that latter & check that the code is working first
 
Upvote 0

Excel Facts

Select a hidden cell
Somehide hide payroll data in column G? Press F5. Type G1. Enter. Look in formula bar while you arrow down through G.
No it's the sheet name not the file name.

Lets worry about that latter & check that the code is working first


Hi colleague and apologize for the late answer, here's how I solved the problem...

{1} First I executed this code for shredding on sheet.


Code:
Sub CopyData()
 
   Dim Ws1 As Worksheet
   Dim cl As Range
  
   Set Ws1 = Sheets("SalesRepData")
  
   If Ws1.AutoFilterMode Then Ws1.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
      For Each cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         If Not .exists(cl.Value) Then
            .Add cl.Value, Nothing
            Ws1.Range("A1").AutoFilter 1, cl.Value
            Worksheets.Add.Name = cl.Value
            Ws1.UsedRange.SpecialCells(xlVisible).Copy Range("A1")
         End If
      Next cl
   End With
   Ws1.AutoFilterMode = False
     
End Sub

{2} after I split them I filled out this code that allows you to save a few blank files

Code:
Sub Splitbook()
MyPath = ThisWorkbook.Path
For Each sht In ThisWorkbook.Sheets
sht.Copy
ActiveSheet.Cells.Copy
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteValues
ActiveSheet.Cells.PasteSpecial Paste:=xlPasteFormats
ActiveWorkbook.SaveAs _
Filename:=MyPath & "\" & sht.Name & ".xlsx"
ActiveWorkbook.Close savechanges:=False
Next sht
End Sub
 
Last edited:
Upvote 0
I would be brave enough to confirm that the code that I provided was working!

CHEERS!!!
 
Last edited:
Upvote 0
Glad you got it working & thanks for the feedback
 
Upvote 0
I figured how to fix this mistake

1.jpg


I have to break 80+ Sheets , but I come to 26-7 and displays the error in the photo.

ideas how can i fix it..?
 
Upvote 0

Forum statistics

Threads
1,215,966
Messages
6,127,974
Members
449,414
Latest member
sameri

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top