none
Excel macros to create multiple spreadsheets

    Question

  • I would like to write a macro that takes data from a spreadsheet and creates multiple personalized spreadsheets using that data.  It would essentially be like a mail merge but an Excel to Excel mail merge instead of an Excel to Word mail merge.  Can someone help me?
    Monday, August 27, 2012 7:13 PM

Answers

  • See if this is what you want:

    The following sample will save data in A1:A3 to workbook1, and save data in B1:B3 to workbook1. And the workbooks will be saved in local drive D:\

    Sub Creation()
        Dim wbNew As Workbook
        
            With ThisWorkbook.Worksheets(1)
            
            ' For single range.
            .Range("A1:A3").Copy
            Set wbNew = Workbooks.Add
            wbNew.Worksheets(1).Paste
            wbNew.SaveAs "D:\" & wbNew.Name
            
            ' For multiple ranges.
            .Range("B1:B3").Copy
            Set wbNew = Workbooks.Add
            wbNew.Worksheets(1).Paste
            wbNew.SaveAs "D:\" & wbNew.Name
            
            End With
        
        Application.CutCopyMode = False
        Set wbNew = Nothing
    End Sub


    Max Meng

    TechNet Community Support

    Tuesday, August 28, 2012 7:30 AM
    Moderator

All replies

  • Excel is best at analyzing and word is best at representing.So if your data contains like small table/chart/letter then you can do it in word mail merge.


    Best Regards,
    Asadulla Javed, Kolkata
    ---------------------------------------------------------------------------------------------
    Please do not forget to click “Vote as Helpful” if any post helps you and "Mark as Answer”if it solves the issue.

    Tuesday, August 28, 2012 6:24 AM
  • See if this is what you want:

    The following sample will save data in A1:A3 to workbook1, and save data in B1:B3 to workbook1. And the workbooks will be saved in local drive D:\

    Sub Creation()
        Dim wbNew As Workbook
        
            With ThisWorkbook.Worksheets(1)
            
            ' For single range.
            .Range("A1:A3").Copy
            Set wbNew = Workbooks.Add
            wbNew.Worksheets(1).Paste
            wbNew.SaveAs "D:\" & wbNew.Name
            
            ' For multiple ranges.
            .Range("B1:B3").Copy
            Set wbNew = Workbooks.Add
            wbNew.Worksheets(1).Paste
            wbNew.SaveAs "D:\" & wbNew.Name
            
            End With
        
        Application.CutCopyMode = False
        Set wbNew = Nothing
    End Sub


    Max Meng

    TechNet Community Support

    Tuesday, August 28, 2012 7:30 AM
    Moderator