Hi Rick,
the code below was run from Access.
It opens a table (Tbl_EPR) in a recordset, then it opens an Excel
spreadsheet and covers rows 1 to 100, extracting the information from
certain columns.
At the end of each row it writes the data to a record in an access
table and then moves to the next column.
This repeats for 13 worksheets within the workbook, all the data being
transferred to one table.
Apologies for the lack of notes in the code, I'm happy to answer any
questions you have about it though.
hope it helps,
Owen
---------------------------------------------
Private Sub btn_Import_Click()
Dim xlApp As Excel.Application
Dim wb As Excel.Workbook
Dim WriteRS As DAO.Recordset
Dim db As DAO.Database
DoCmd.SetWarnings (0)
DoCmd.RunSQL "DELETE FROM Tbl_EPR"
DoCmd.SetWarnings (-1)
Set db = CurrentDb
Set WriteRS = db.OpenRecordset("tbl_EPR", dbOpenDynaset)
Set xlApp = CreateObject("Excel.Application")
Set wb = xlApp.Workbooks.Open("P:\Roger\revenue\MMPR.xls")
Dim col As Integer
Dim row As Integer
Dim WorksheetName As String
Dim acctNo As String
Dim CoName As String
Dim acctMan As String
Dim revenue As String
Dim Products As String
Dim currentMonth As String
Dim lastrow As Integer
Dim Y As Integer
Y = 1
Do While Y <= 13
wb.Worksheets(Y).Activate
row = 3
Do While row <= 100
acctNo = wb.Worksheets(Y).Cells(row, 2).Value
CoName = wb.Worksheets(Y).Cells(row, 1).Value
acctMan = wb.Worksheets(Y).Cells(row, 3).Value
revenue = wb.Worksheets(Y).Cells(row, 17).Value
col = 4
Do While col <= 17
If wb.Worksheets(Y).Cells(row, col) <> "" Then
If Products = "" Then
Products = wb.Worksheets(Y).Cells(2, col).Value
Else
Products = Products & ", " & wb.Worksheets(Y).Cells(2,
col).Value
End If
End If
col = col + 1
Loop
With WriteRS
.AddNew
!Acct_no = acctNo
!name = CoName
!Acct_Man = acctMan
If revenue <> "" Then
!Total = revenue
End If
!Products = Products
!monthdue = wb.Worksheets(Y).name
.Update
End With
Products = ""
acctNo = ""
CoName = ""
acctMan = ""
revenue = ""
row = row + 1
Loop 'end row 3 - last row
Y = Y + 1 'end worksheets
Loop
wb.Close
Set WriteRS = Nothing
Set xlApp = Nothing
Set db = Nothing
------------------------------------------------
Yahoo! Groups Links
<*> To visit your group on the web, go to:
http://groups.yahoo.com/group/AccessVBACentral/
<*> To unsubscribe from this group, send an email to:
[EMAIL PROTECTED]
<*> Your use of Yahoo! Groups is subject to:
http://docs.yahoo.com/info/terms/
