Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 2752
  • Last Modified:

Export Access Table to Multiple Excel Worksheets

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
shieldsco
Asked:
shieldsco
  • 2
1 Solution
 
Rey Obrero (Capricorn1)Commented:
0
 
MacroShadowCommented:
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
 
shieldscoAuthor Commented:
Works Great -- Thanks
0
 
MacroShadowCommented:
glad to help.
0

Featured Post

Efficient way to get backups off site to Azure

This user guide provides instructions on how to deploy and configure both a StoneFly Scale Out NAS Enterprise Cloud Drive virtual machine and Veeam Cloud Connect in the Microsoft Azure Cloud.

  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now