Solved

Export Access Table to Multiple Excel Worksheets

Posted on 2014-04-02
4
2,094 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 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 39972706
0
 
LVL 27

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 27

Expert Comment

by:MacroShadow
ID: 39972920
glad to help.
0

Featured Post

Use Case: Protecting a Hybrid Cloud Infrastructure

Microsoft Azure is rapidly becoming the norm in dynamic IT environments. This document describes the challenges that organizations face when protecting data in a hybrid cloud IT environment and presents a use case to demonstrate how Acronis Backup protects all data.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

831 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