Thanks, Owen! I'm going to digest this over lunch and get back to you with any questions.
Rick --- In [email protected], "owen_group_profile" <[EMAIL PROTECTED]> wrote: > > 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/
