How to make separate excel work book .

[avisoft20]

Hello Everyone Namaste,
I have a problem in Excel Data Base.I hope you will help me.Table given below :

For Example : Master Data Base.Xls

Code	Name	Designation	State
2001	Ankuush	A.S.E	Haryana
2001	Shiv	A.S.E	Haryana
2001	Ramesh	A.S.S	Uttar Pradeh
2001	Rama	A.S.S	Punjab
2002	Shyama	A.S.E	Punjab
2002	Chander	A.S.E	Punjab
2002	Mander	A.S.M	Uttar Pradeh
2002	Kundan	A.S.S	Haryana
2009	Rana	A.S.O	Haryana
2009	Rane	A.S.O	Uttar Pradeh
2009	Rakesh	A.S.S	Delhi
2009	Rajesh	A.S.M	Haryana
2013	Ritika	A.S.M	Delhi
2013	Ruchika	A.S.O	Uttar Pradeh
2013	Rani	A.S.O	Delhi
2013	Chandani	A.S.S	Delhi
2013	Mannu	A.S.M	Punjab

<tbody>
</tbody>

In this table i have multiple state on Sheet 1.but i want each state have separate workbook also workbook will be rename with their state name.kindly tell me how can i make separate work book .I have big data base.

And ans will be :First Workbook name will Delhi.xls

Code	Name	Designation	State
2009	Rakesh	A.S.S	Delhi
2013	Ritika	A.S.M	Delhi
2013	Rani	A.S.O	Delhi
2013	Chandani	A.S.S	Delhi

<tbody>
</tbody>

Second Workbook name will Haryana.xls

Code	Name	Designation	State
2001	Ankuush	A.S.E	Haryana
2001	Shiv	A.S.E	Haryana
2002	Kundan	A.S.S	Haryana
2009	Rana	A.S.O	Haryana
2009	Rajesh	A.S.M	Haryana

<tbody>
</tbody>

--------------------------------------------------

Third Workbook name will Punjab.xls

Code	Name	Designation	State
2001	Rama	A.S.S	Punjab
2002	Shyama	A.S.E	Punjab
2002	Chander	A.S.E	Punjab
2013	Mannu	A.S.M	Punjab

<tbody>
</tbody>

------------------------------------------------------------------------------------
Fourth Workbook name will Uttar Pradesh.xls

Code	Name	Designation	State
2001	Ramesh	A.S.S	Uttar Pradeh
2002	Mander	A.S.M	Uttar Pradeh
2009	Rane	A.S.O	Uttar Pradeh
2013	Ruchika	A.S.O	Uttar Pradeh

<tbody>
</tbody>

Thanks & Regards
Avinash Kumar Singh

 

[Veritan]

Hello Avinash and welcome to MrExcel. Try inserting the code below into a module in your Master Data Base file and then running it.

Sub Book_by_State()
    Dim r As Range, i As Integer, States() As String, State_Count As Integer
    Dim Data() As Variant, x As Long, y As Integer
    
    Application.ScreenUpdating = False
    Range("D2", Range("D1").End(xlDown)).Copy
    Range("E2").PasteSpecial 'If necessary, change this to be a location without any data in it.
    Selection.RemoveDuplicates Columns:=1, Header:=xlNo
    State_Count = Range("E2", Range("E2").End(xlDown)).Count 'This needs to be the location where the States were copied to.
    
    ReDim States(1 To State_Count)
    For i = 1 To State_Count
        Range("A1:D1").Copy
        States(i) = Range("E" & i + 1) 'This also needs to be the location where the States were copied to.
        For Each r In Range("A2", Range("A1").End(xlDown))
            If r.Offset(, 3) = States(i) Then
                x = x + 1
                ReDim Preserve Data(1 To 4, 1 To x)
                For y = 1 To 4
                    Data(y, x) = r.Offset(, y - 1)
                Next y
            End If
        Next r
        Workbooks.Add
        Range("A1").PasteSpecial
        Range("A2:D" & x + 1) = Application.Transpose(Data)
        Columns.AutoFit
        x = 0
        Erase Data
        'Change the file path below to be where you want the files to be saved.
        ActiveWorkbook.SaveAs Environ("UserProfile") & "\Desktop\" & States(i) & ".xls"
        ActiveWorkbook.Close
    Next i
    Columns(5).Delete 'Make this the column where the States were copied to in the Master Data Base.
    Range("A1").Select
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
End Sub

Please be aware that this code assumes that you have nothing in Column E in your Master Data Base file. You'll want to make sure that the States are copied to a place without any data in your Master Data Base. The code also saves the workbooks to your desktop. You may want to change where it saves the files. Finally, I am using Excel 2013. If you are using a different version, you may need to alter the ActiveWorkbook.SaveAs line. Best of luck!

 

[avisoft20]

Thanks Mr Veritan

Its Working Thank you so much for your valuable time.




Regards :
Aviansh Kumar Singh

 

[avisoft20]

when i run this code its split multiple file.xls, i want .pdf which is supported in Adobe Acrobat (.pdf) is it possible Mr Veritan.




Thanks & Regards :
Avinash Kumar Singh

 

[Veritan]

Yes, you can save the files as PDF's. How you do it depends on whether or not you want to keep an Excel version as well as the PDF. In both cases, you'll be replacing these two lines in the code I wrote above:

        ActiveWorkbook.SaveAs Environ("UserProfile") & "\Desktop\" & States(i) & ".xls"
        ActiveWorkbook.Close

If you want to only save a PDF version, use this code to replace the two lines above:

        'Change the Filename below to be where you want the files to be saved.
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Environ("UserProfile") & "\Desktop\" & States(i) & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False


        ActiveWorkbook.Close SaveChanges:=False

If you would also like to keep an Excel copy of your data, use this code instead:

        'Change the Filename below to be where you want the files to be saved.
        ActiveSheet.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=Environ("UserProfile") & "\Desktop\" & States(i) & ".pdf", _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False


        ActiveWorkbook.SaveAs Environ("UserProfile") & "\Desktop\" & States(i) & ".xls"
        ActiveWorkbook.Close

 

[avisoft20]

Hello Sir,

I have number of column ,for example i have 24 column, given below,

Calculation Run| , Agreement| , IP Document| , Site| , Department| , Mdse Cat.| , Merchandise Category| , Brand| , Brand| , Brand| , Article| , Article Number| , Vendor| , Purch.Doc.| , contract no.| , PO Date| , Pstng Date| , GR QTY| , GR CP VALUE| , GR CP VALUE NET| , GR MRP| , States|

I want split workbook by (States) column .

Please help me

i am using this code :


Sub Book_by_State()
Dim r As Range, i As Integer, States() As String, State_Count As Integer
Dim Data() As Variant, x As Long, y As Integer

Application.ScreenUpdating = False
Range("D2", Range("D1").End(xlDown)).Copy
Range("E2").PasteSpecial 'If necessary, change this to be a location without any data in it.
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
State_Count = Range("E2", Range("E2").End(xlDown)).Count 'This needs to be the location where the States were copied to.

ReDim States(1 To State_Count)
For i = 1 To State_Count
Range("A1:D1").Copy
States(i) = Range("E" & i + 1) 'This also needs to be the location where the States were copied to.
For Each r In Range("A2", Range("A1").End(xlDown))
If r.Offset(, 3) = States(i) Then
x = x + 1
ReDim Preserve Data(1 To 4, 1 To x)
For y = 1 To 4
Data(y, x) = r.Offset(, y - 1)
Next y
End If
Next r
Workbooks.Add
Range("A1").PasteSpecial
Range("A2:D" & x + 1) = Application.Transpose(Data)
Columns.AutoFit
x = 0
Erase Data
'Change the file path below to be where you want the files to be saved in xls .
ActiveWorkbook.SaveAs Environ("UserProfile") & "\Desktop\shiv" & States(i) & "*.xls"
'Change the file path below to be where you want the files to be saved in pdf .
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Environ("UserProfile") & "\Desktop\shiv" & States(i) & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveWorkbook.Close SaveChanges:=False
ActiveWorkbook.Close
Next i
Columns(5).Delete 'Make this the column where the States were copied to in the Master Data Base.
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub




Thanks & Regards
Avinash Kumar Singh

 

[avisoft20]

Sub Book_by_State()
Dim r As Range, i As Integer, States() As String, State_Count As Integer
Dim Data() As Variant, x As Long, y As Integer

Application.ScreenUpdating = False
Range("D2", Range("D1").End(xlDown)).Copy
Range("E2").PasteSpecial 'If necessary, change this to be a location without any data in it.
Selection.RemoveDuplicates Columns:=1, Header:=xlNo
State_Count = Range("E2", Range("E2").End(xlDown)).Count 'This needs to be the location where the States were copied to.

ReDim States(1 To State_Count)
For i = 1 To State_Count
Range("A1:D1").Copy
States(i) = Range("E" & i + 1) 'This also needs to be the location where the States were copied to.
For Each r In Range("A2", Range("A1").End(xlDown))
If r.Offset(, 3) = States(i) Then
x = x + 1
ReDim Preserve Data(1 To 4, 1 To x)
For y = 1 To 4
Data(y, x) = r.Offset(, y - 1)
Next y
End If
Next r
Workbooks.Add
Range("A1").PasteSpecial
Range("A2:D" & x + 1) = Application.Transpose(Data)
Columns.AutoFit
x = 0
Erase Data
'Change the file path below to be where you want the files to be saved.
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Environ("UserProfile") & "\Desktop\shiv\5" & States(i) & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
ActiveWorkbook.Close SaveChanges:=False
Next i
Columns(5).Delete 'Make this the column where the States were copied to in the Master Data Base.
Range("A1").Select
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub



=-----
The above code is used for make separate excel file .








ActiveWorkbook.Close SaveChanges:=False



This also for save in .PDF format

but i have problem in page setup for pdf file, code is given below and its working .
Sub Rectangle1_Click()
Dim sFullName As String
Dim Ans As Long
Dim bsavepdf As Boolean
sFullName = "C:\TEST" & Range("B2").Value
Do
If Len(Dir(sFullName, vbNormal)) = 0 Then
bsavepdf = True
Else
Ans = MsgBox("File already exists. Overwirte?", vbQuestion + vbYesNoCancel, "Overwrite?")
Select Case Ans
Case vbYes
bsavepdf = True
Case vbNo
sFullName = Application.GetSaveAsFilename(InitialFileName:=sFullName, _
FileFilter:="PDF (*.pdf), *.pdf", Title:="Save As", ButtonText:="Save")
If sFullName = "False" Then Exit Sub
Case vbCancel
Exit Sub
End Select
End If
Loop Until bsavepdf
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sFullName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub



how to implement both ?

 

[Ingolf]

Hello Sir,

I have number of column ,for example i have 24 column, given below,

Calculation Run| , Agreement| , IP Document| , Site| , Department| , Mdse Cat.| , Merchandise Category| , Brand| , Brand| , Brand| , Article| , Article Number| , Vendor| , Purch.Doc.| , contract no.| , PO Date| , Pstng Date| , GR QTY| , GR CP VALUE| , GR CP VALUE NET| , GR MRP| , States|

I want split workbook by (States) column .

You say "i have 24 column, given below,"

and there are only 23

Which one is correct? Is your state column nr 23?