Solved

Export Access Table to Multiple Excel Worksheets

Posted on 2014-04-02
4
1,918 Views
Last Modified: 2014-04-02
I have an Access table that I would like to export to Excel. I need to create a seperate worksheet in the Excel workbook for each staff member from the table (tblInvoice.FullName) and then update records from the table to the individual worksheets based on the staff member. Thanks
0
Comment
Question by:shieldsco
  • 2
4 Comments
 
LVL 119

Expert Comment

by:Rey Obrero
ID: 39972706
0
 
LVL 26

Accepted Solution

by:
MacroShadow earned 500 total points
ID: 39972770
Import the whole table to a worksheet, then you can use the following code from (http://www.extendoffice.com/documents/excel/1174-excel-split-data-into-multiple-worksheets-based-on-column.html) to create a new worksheet per staff member.
Sub parse_data()
    Dim lr As Long
    Dim ws As Worksheet
    Dim vcol, i As Integer
    Dim icol As Long
    Dim myarr As Variant
    Dim title As String
    Dim titlerow As Integer
    vcol = 1
    Set ws = Sheets("Sheet1")
    lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
    title = "A1:C1"
    titlerow = ws.Range(title).Cells(1).Row
    icol = ws.Columns.Count
    ws.Cells(1, icol) = "Unique"
    For i = 2 To lr
        On Error Resume Next
        If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Then
            ws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
        End If
    Next
    myarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
    ws.Columns(icol).Clear
    For i = 2 To UBound(myarr)
        ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
        If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
            Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
        Else
            Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
        End If
        ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
        Sheets(myarr(i) & "").Columns.AutoFit
    Next
    ws.AutoFilterMode = False
    ws.Activate
End Sub

Open in new window

Instructions:
These are the 3 key variables, change them accordingly.

1.

vcol =1, the number 1 is the column number that you want to split the data based on. So if the staff member's FullName is not in the first column (A), replace 1 with the relevant column number.

2.

Set ws = Sheets("Sheet1"), Sheet1 is the sheet name that you want to apply this code.

3.

title = "A1:C1", this assumes that the sheet includes a title row in A1:C1.
0
 

Author Closing Comment

by:shieldsco
ID: 39972863
Works Great -- Thanks
0
 
LVL 26

Expert Comment

by:MacroShadow
ID: 39972920
glad to help.
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

I originally created this report in Crystal Reports 2008 where there is an option to underlay sections. I initially came across the problem in Access Reports where I was unable to run my border lines down through the entire page as I was using the P…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

23 Experts available now in Live!

Get 1:1 Help Now