Link to home
Start Free TrialLog in
Avatar of YuKeith
YuKeith

asked on

How do I use Copy/Cut/Past function in Access VBA to work with Excel Worksheets?

Hi,

I want to use Access VBA to update an Excel workbook that has 70 worksheets. I stored all worksheet name in an Access table. I want to open each worksheet and update its data. I don't know the correct way of using Excel functions such as Copy and Paste with Access VBA. I got automation errors when I run my code.  Here is part of my codes in my module.

    Set App = New Excel.Application
    Set Wb = App.Workbooks.Open(FilePath, False)
    App.Visible = True
   
    Set db = CurrentDb
    Set rs = db.OpenRecordset("qryAllWorksheetNames")
   
    rs.MoveFirst

    Num = Wb.Worksheets.Count
    SheetName = ""
   
    Do While Not rs.EOF
        For i = 2 To Num
            SheetName = Wb.Worksheets(i).Name
            If rs![SheetName] = SheetName Then          
'  1. Cut/Paste range(A14:O22) to range(A13:O21)
                With Wb.Worksheets(i)              
                    .Range("A14:N22").Cut
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A13:N21")                    
'  2. Delete range(O13)
                    .Range("O13").Value = ""                   
'  3. Cut/Paste range(A3:O11) to range(A2:O10)
                    .Range("A3:N11").Cut
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A2:N10")                  
'  4. Copy range(A10) to range(A11)
                    .Range("A10").Copy
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A11")
'  5. Change formula for O24
                    Range("O24").Formula = "=N24/N22-1"                    
                End With              
                Exit For
            End If
        Next i
        rs.MoveNext
    Loop                    
    App.ActiveWorkbook.Close savechanges:=True
    App.Quit
    Set App = Nothing

Any help or suggestion would be greatly appriciated.

Keith
Avatar of farnsworth
farnsworth

Where are the errors occuring in the code?
ASKER CERTIFIED SOLUTION
Avatar of farnsworth
farnsworth

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of YuKeith

ASKER

Hi Farnsworth,

Thank you for your quick reply.  I will try you suggestion on the way opening workbook even I don't see any error to open Workbook with my current code.  I did referece to Excel object.  I some times don't see any error if I use the ! icon in Access module to run this function. However, there are two problem when it does run without error. 1. It updates Worksheets(1) even the loop should start from Worksheets(2). 2. It create an instance of Excel in back end which my code can not close.  I will definary get automation errors if I run one line of code at a time when it gets to " ActiveSheet.Paste Destination:=Worksheets(i).Range("A13:N21")".  Here is my full code:

Public Function UpdateEnplanement()

    Dim FilePath As String
    FilePath = "C:\0304Revenue\Air Traffic\PAX  Enplanement.xls"

    Dim App As Excel.Application
    Dim Wb As Workbook
    Dim Ws As Worksheet
    Dim db As Database
    Dim rs As Recordset
    Dim Num As Integer
    Dim SheetName As String
    Dim intIdx As String
    Dim ColumnNum As String
    Dim i As Integer
    Dim FY As Integer
    Dim LFY As Integer
    Dim NFY As Integer
    Dim LFYear As String
    Dim FYear As String
    Dim FYearP As String
    Dim FYearAP As String
   
    FY = Right(DLookup("FY", "qryCurrentFY"), 2)
    LFY = FY - 1
    NFY = FY + 1
   
    LFYear = "FY0" & LFY & "/" & "0" & FY           'FY02-03
    FYear = "FY0" & FY & "/" & "0" & NFY            'FY03-04
    FYearP = "FY0" & FY & "/" & "0" & NFY & "p"     'FY03-04p
    FYearAP = "FY0" & FY & "/" & "0" & NFY & "A+p"  'FY03-04A+p
       
    Set App = New Excel.Application
    Set Wb = App.Workbooks.Open(FilePath, False)
    App.Visible = True
   
    If App.ActiveWorkbook.ReadOnly = True Then
        App.ActiveWorkbook.Close savechanges:=False
        Set App = Nothing
        Exit Function
    End If

    Set db = CurrentDb
    Set rs = db.OpenRecordset("qryAllExcelSheetNames")
   
    rs.MoveFirst

    Num = Wb.Worksheets.Count
    SheetName = ""
   
    For i = 2 To Num
        Set Ws = Wb.Worksheets(i)
        App.ActiveWorkbook.Worksheets(i).Unprotect "12345"
    Next i
   
    Do While Not rs.EOF
        For i = 2 To Num
            SheetName = Wb.Worksheets(i).Name
            If rs![SheetName] = SheetName Then
           
'  1. Cut/Paste range(A14:O22) to range(A13:O21)
                With Wb.Worksheets(i)
               
                    .Range("A14:N22").Cut
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A13:N21")
                   
'  2. Delete range(O13)
                    .Range("O13").Value = ""
                   
'  3. Cut/Paste range(A3:O11) to range(A2:O10)
                    .Range("A3:N11").Cut
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A2:N10")
                   
'  4. Copy range(A10) to range(A11)
                    .Range("A10").Copy
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A11")
                   
'  5. Change A11 value to last fiscal year
                    .Range("A11").Value = LFYear
                   
'  6. Copy range(A21) to range(A22)
                    .Range("A21").Copy
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("A22")

'  7. Change A22 value to last fiscal year
                    .Range("A22").Value = LFYear

'  8. Change A23 value to current fiscal year
                    .Range("A23").Value = FYearP

'  9. Change A24 value to current fiscal year
                    .Range("A24").Value = FYearAP

'  10. Copy range(B10:M10) to range(B11:M11) and change 21 to 22
                    Range("B11").Formula = "=B22/$N$22"
                    Range("C11").Formula = "=C22/$N$22"
                    Range("D11").Formula = "=D22/$N$22"
                    Range("E11").Formula = "=E22/$N$22"
                    Range("F11").Formula = "=F22/$N$22"
                    Range("G11").Formula = "=G22/$N$22"
                    Range("H11").Formula = "=H22/$N$22"
                    Range("I11").Formula = "=I22/$N$22"
                    Range("J11").Formula = "=J22/$N$22"
                    Range("K11").Formula = "=K22/$N$22"
                    Range("L11").Formula = "=L22/$N$22"
                    Range("M11").Formula = "=M22/$N$22"
                   
                    Range("N10").Copy
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("N11")

'  11. Copy/Paste range(B24:M24) to range(B22:M22)
                    Range("B24:M24").Copy
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("B22:M22")
                   

'  12. Copy/Paste range(N24) to range(N22)
                    Range("N24").Copy
                    ActiveSheet.Paste Destination:=Worksheets(i).Range("N22")

'  13. Change formula for O24
                    Range("O24").Formula = "=N24/N22-1"
                   
                End With
               
                Exit For
            End If
        Next i
        rs.MoveNext
    Loop
                   
    For i = 2 To Num
        Set Ws = Wb.Worksheets(i)
        App.ActiveWorkbook.Worksheets(i).Protect "12345"
    Next i
   
    App.ActiveWorkbook.Close savechanges:=True
    App.Quit
    Set App = Nothing
   
    rs.Close
    Set rs = Nothing
   
    db.Close
    Set db = Nothing
           
End Function

Hope you can give me some suggestion on my problem code.

Thank you

Keith
Wait, did this work for you? I noticed you posted the comment after you accepted the answer, or vice versa.  If you are having trouble with Excel not closing, I have found that is because when you use Excel commands without the App. it leaves an open Excel when the code finishes. If you begin each Excel statement with the App. (application reference variable), this seems to go away. Let me know if you are still having problems.