Question

我正在尝试将一个excel工作表从Access中复制到另一个工作簿，并继续使下标超出范围错误。我尝试了一些不同的东西，但似乎无法确定它。任何帮助，将不胜感激。使用Access和Excel 2010，我的代码如下：

Dim strTaxMonth As String
Dim strTaxYear As String
Dim strTabName As String
Dim objExcel As Excel.Application
Dim objWB As Workbook
Dim objWS As Worksheet
Dim strExcelFile0 As String
Dim strExcelFile1 As String
Dim strExcelFile2 As String

strTaxMonth = Forms!frm_PayrollTax_Report!ReportMonth
strTaxYear = Forms!frm_PayrollTax_Report!ReportYear
strTabName = strTaxMonth & strTaxYear & "_PTAX"
strExcelFile0 = "C:\File0.xlsm"
strExcelFile1 = "C:\File1.xlsx"
strExcelFile2 = "C:\File2.xlsm"


'Copy Worksheet to Yearly File


Set objExcel = New Excel.Application
objExcel.Visible = True
objExcel.DisplayAlerts = False

If Len(Dir(strExcelFile1)) > 0 Then Kill strExcelFile1

Set objWB = objExcel.Workbooks.Open(strExcelFile0)
objWB.Activate
Set objWS = objExcel.Sheets("PTAX")
objWS.Activate
objWS.Unprotect
objWS.Select
objWS.Name = strTabName
objWS.Range("A1:I16").Select
objWS.Range("A1:I16").Copy
objWS.Range("A1:I16").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
objWS.Range("B19:I28").Select
objWS.Range("B19:I28").Copy
objWS.Range("B19:I28").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
objWS.Protect
objWS.Select
objExcel.Workbooks.Open(strExcelFile0).Sheets(strTabName).Copy After:=objExcel.Workbooks.Open(strExcelFile2).Sheets("YTD PTAX")
objExcel.Workbooks(strExcelFile0).Activate
objExcel.ActiveWorkbook.SaveAs strExcelFile1
objExcel.ActiveWorkbook.Close False
objExcel.Quit
Set objExcel = Nothing
Set objWB = Nothing
Set objWS = Nothing

End Sub

Answer 1

只需使用这段代码

    Sub test()

     Dim xlapp as New Excel.Application
     Dim xlwkb as Workbook
     Dim xlsht as Worksheet
     Dim xlwkb2 as Workbook
     Dim xlsht2 as Worksheet

    xlapp.DisplayAlerts=False

    'First workbook and Sheet
        Set xlwkb=xlapp.Workbooks.Open(strExcelFile0)
        Set xlsht=xlwkb.Worksheets(1)

    'Second workbook and Sheet
        Set xlwkb2=xlapp.Workbooks.Open(strExcelFile0)
        Set xlsht2=xlwkb.Worksheets(1)

        xlsht.Range("A1:B16").Copy Destination:=xlsht2.Range("A1")

        Set xlsht=Nothing
        xlwkb.Close
        Set xlwkb=Nothing

        xlwkb2.Saveas "C:\File.xls"
        Set xlsht2=Nothing
        xlwkb2.Close

     xlapp.DisplayAlerts=True

        Set xlapp=Nothing
        xlapp.Quit

End Sub

尝试从Access中将Excel工作表复制到另一个工作簿

1 个答案: