X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
> Use Access To Open Excel File Find Last Column And Copy/paste, Access 2016    
post Sep 11 2019, 12:56 PM

Posts: 59
Joined: 7-January 11

So I have a task I would like to automate. Currently a spreadsheet is emailed out each week that identifies liability of product we have however each week that the spreadsheet comes out, they add two columns to the end in order to track weekly progress.

In short, I am trying to develop some code that will grab the last two columns (which are the summary columns of all the weeks) and copy them to a far-off consistence column (i.e. copy columns AA and AB to DA and DB). This way I can consistently import the data into Access for processing and merge other data elements with this emailed spreadsheet to better inform my team but this adding of columns each week is problematic for Access and the assigned fields.

Below is the closest thing I have found online (most of the other examples have been excel specific and not access). How do I adjust the below to what I am wanting to do?

Option Compare Database

Sub GetLastRow(MyRange As Excel.Range)
    Dim lngLastRow As Long

    With MyRange.Worksheet
        lngLastRow = .Cells(.Rows.Count, MyRange.Column).End(xlUp).Row
        .Range(.Cells(lngLastRow + 1, 1), .Cells(.Rows.Count, 1)).EntireRow.Delete
    End With
End Sub

Function CreateExcelData()
'Copies data to be exported to an Excel workbook
Dim objExcel         As Excel.Application
Dim strTemplate      As String
Dim strPathFile      As String
Dim RowCount         As Integer
Dim wbExported       As Workbook  'The initial exported data
Dim wbAllData        As Workbook   'Workbook to copy exported data to
Dim rngUsed          As Range        'Used range in exported data
Dim Sheet            As Worksheet

'Try GetObject first in case Excel Application is already open.
On Error Resume Next
Set objExcel = GetObject(, "excel.Application")
If Err.Number <> 0 Then
    'GetObject returns error if not already open
    'so use CreateObject
    On Error GoTo 0 'Turnoff ASAP so error trapping is available
    Set objExcel = CreateObject("Excel.Application")
End If

strTemplate = "TEMPLATE.xlsm"
strPathFile = strPath & strTemplate
strPathFileFinal = strPath & strReportName & "_" & Mydat & ".xlsm"

FileCopy strPathFile, strPathFileFinal

'Open the exported data workbook and assign to a variable
Set wbExported = objExcel.Workbooks.Open(strFilePath)

'Open the data workbook to receive the exported data and assign to a variable.
Set wbAllData = objExcel.Workbooks.Open(strPathFileFinal)

'Exported data
With wbExported.Sheets(1).UsedRange
    Set rngUsed = .Offset(1, 0) _
        .Resize(.Rows.Count - 1, .Columns.Count)
End With

With wbAllData.Sheets("MainSheet")
    'Copy exported data and paste to first empty cell of MainSheet in File
    .Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
End With

Call GetLastRow("MainSheet", "A")



Set rngUsed = Nothing
Set wbExported = Nothing
Set wbAllData = Nothing
Set objExcel = Nothing

Kill strFilePath

End Function
Go to the top of the page

Posts in this topic

Custom Search

RSSSearch   Top   Lo-Fi    16th October 2019 - 04:26 AM