• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

split data from master workbook to another workbook.

how to split data from master workbook to another workbook?

  • Total voters
    1
M

margil patel

New Member
Hi.....

I am working with excel VBA. I 've great experience from this forum. this is really helpful for me.
please see my upload file and solve my problem. just i want split data from master workbook to another workbook.

thanks in advance
 

Attachments

  • Example.zip
    31.3 KB · Views: 19
Hi Margil

When moving data to a seperate workbook it is important to move the data all in one go rather than line by line. The following treats the information as a bulk upload. Just change the file path to suit.

Code: 
Option Explicit

Sub SavetoWB()  'Excel VBA to export data
Const sPath = "C:\Users\HYMC\theSmallman\Test\"
Dim ar As Variant
Dim i As Integer
Dim owb As Workbook

Range("A3", Range("A" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [T1], True
ar = Range("T2", Range("T2").End(xlDown))
'Loop through all unique instances of the Results from the Advanced Filter.
    For i = 1 To UBound(ar)
        Range("A3", Range("A" & Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
        Range("A3", Range("N" & Rows.Count).End(xlUp)).Copy 'Where Data is from Col A - N
        Set owb = Workbooks.Add
        owb.Sheets(1).[A1].PasteSpecial xlPasteValues
        owb.SaveAs sPath & [A2]
        owb.Close False 'Close no save
    Next i
  
[a3].AutoFilter
Columns(20).EntireColumn.Clear
End Sub

File attached to show workings.

Take care

Smallman
 

Attachments

  • MasterV1.xlsm
    19.8 KB · Views: 17
thanks smallman, your code is working, but i want move data line by line, this is a daily update file so when i moved data day by day this code is delete previous date data and input next date data.

please give me solution of this....
 
So in the files you have just created do you want to add new data to the files. The code won't delete new data it will create a fresh file with all of the information on it. There is no delete procedure in the code. It may overwrite yesterdays file but this is simply a naming convention issue.

I am just guessing though. If I was to guess futher I would say you would not want to treat each line individually. Which ever way you decide to go there will be a method to treat the information in a batch. I won't be awake to see your response but if no one has responded I will address this tomorrow.

Take care

Smallman
 
Check this...

Code: 
Sub split_Symbol()
Dim l As Long, smbl() As String, r As Range
Dim i As Long, lr As Long, lrr As Range, wb As Workbook
Application.ScreenUpdating = False
l = Cells(Rows.Count, 1).End(xlUp).Row

ReDim smbl(1 To 1) As String
smbl(1) = "Test"

For Each r In Range("A1:A" & l)
    If r.Value <> "SYMBOL" And Len(r) > 0 Then
        If Not UBound(Filter(smbl, r.Value)) > -1 Then
            ReDim Preserve smbl(1 To UBound(smbl) + 1) As String
            smbl(UBound(smbl)) = r.Value
       End If
    End If
Next

For i = LBound(smbl) + 1 To UBound(smbl)
    Set wb = Workbooks.Add
    lr = 2
    Windows(ThisWorkbook.Name).Activate
    For Each r In Range("A1:A" & l)
        If r.Value = smbl(i) Then
            r.Resize(1, 14).Copy
                With wb
                    With .Sheets(1)
                        .[A1:N1] = Array("SYMBOL", " SERIES", " DATE1", " PREV_CLOSE", " OPEN_PRICE", _
                            " HIGH_PRICE", " LOW_PRICE", " LAST_PRICE", " CLOSE_PRICE", " AVG_PRICE", _
                                " TTL_TRD_QNTY", " TURNOVER_LACS", " DELIV_QTY", " DELIV_PER")
                        Set lrr = .Cells(.Rows.Count, 1).End(xlUp)(2)
                        .Cells(lr, 1).PasteSpecial xlPasteValues
                        lr = lr + 1
                    End With
                End With
        End If
Next
    wb.SaveAs Application.ThisWorkbook.Path & "\" & smbl(i)
wb.Close False
Next
Application.ScreenUpdating = True
End Sub
 
Hi,

For overwriting issue just change the below line
Code: 
wb.SaveAs Application.ThisWorkbook.Path & "\" & smbl(i)

to

Code: 
wb.SaveAs Application.ThisWorkbook.Path & "\" & smbl(i) & Format(Date, "DDMMYY")
 
If you only want to overwrite the current file if it exists the only thing you need to add to the original procedure is a check to see if the file exists.

Code: 
Sub SavetoWB2()  'Excel VBA to export data
Dim ar As Variant
Dim i As Integer
Dim owb As Workbook
Dim fil As String
Dim ws As Worksheet
 
Set ws = Sheet1
Application.DisplayAlerts = False
Range("A3", Range("A" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [T1], True
ar = Range("T2", Range("T2").End(xlDown))
'Loop through all unique instances of the Results from the Advanced Filter.
    For i = 1 To UBound(ar)
        fil = "D:\Test\" & ar(i, 1) & ".xlsx"
        If Dir(fil) = "" Then: Set owb = Workbooks.Add
        Else: Set owb = Workbooks.Open(fil)
        End If
        owb.Sheets(1).[a1].CurrentRegion.Clear
        ws.Range("A3", ws.Range("A" & Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
        ws.Range("A3", ws.Range("N" & Rows.Count).End(xlUp)).Copy 'Where Data is from Col A - N
        owb.Sheets(1).[a1].PasteSpecial xlPasteValues
        owb.SaveAs fil
        owb.Close False 'Close no save
    Next i
[a3].AutoFilter
Columns(20).EntireColumn.Clear
Application.DisplayAlerts = True
End Sub


This keeps things relatively simple. Just ensure the file Path is OK. I tested this on my machine and it goes well.

Take Care

Smallman
 
Last edited:
Thanks Smallman, Your last post is very good. is this possible to add (copy) data like, previous date data keep as it is and add (copy) next day data in next row. I have an example please look it. In this example add (copy) only one symbol's data which i specified symbol path , but i want add (copy) all symbols data.
 

Attachments

  • Main.xlsm
    17.3 KB · Views: 10
Hi Margil

This should see you over the line.

Code: 
Sub SavetoWB3()  'Excel VBA to export data
Dim ar As Variant
Dim i As Integer
Dim owb As Workbook
Dim fil As String
Dim ws As Worksheet
 
Set ws = Sheet1
Application.DisplayAlerts = False
Range("A1", Range("A" & Rows.Count).End(xlUp)).AdvancedFilter xlFilterCopy, , [T1], True
ar = Range("T2", Range("T2").End(xlDown))
'Loop through all unique instances of the Results from the Advanced Filter.
    For i = 1 To UBound(ar)
        fil = "D:\Test\" & ar(i, 1) & ".xlsx"
        If Dir(fil) = "" Then: Set owb = Workbooks.Add
        Else: Set owb = Workbooks.Open(fil)
        End If
        ws.Range("A1", ws.Range("A" & Rows.Count).End(xlUp)).AutoFilter 1, ar(i, 1)
        ws.Range("A2", ws.Range("N" & Rows.Count).End(xlUp)).Copy 'Where Data is from Col A - N
        owb.Sheets(1).Range("A65536").End(xlUp)(2).PasteSpecial xlPasteValues
        owb.SaveAs fil
        owb.Close False 'Close no save
    Next i
[a3].AutoFilter
Columns(20).EntireColumn.Clear
Application.DisplayAlerts = True
End Sub

What you want to do is remove the line which deletes the old data and find the last used row in the workbook you opened. Your file format keeps changing. Data now starts in Row 1???

Anyway I adjusted the code to suit.

Take care

Smallman
 
Kind words indeed. You are most welcome. All the very best and you know where to come if you have further questions. My work is very slow at the moment so I spend much of my days posting.

Take care

Smallman
 
You must log in or register to reply here.
Back
Top