no problems. I'm on GMT though so am just about to head home for the day, will check in again tomorrow morning.
btw - you'll need to add two references to the database: microsoft DAO 3.6 library microsoft excel x library Owen --- In [email protected], "Rick" <[EMAIL PROTECTED]> wrote: > 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/
