多个单元格的复制

最新推荐文章于 2021-08-12 16:29:10 发布

HaoChunhui

最新推荐文章于 2021-08-12 16:29:10 发布

阅读量827

点赞数

分类专栏：程序设计文章标签： microsoft library excel object

本文链接：https://blog.csdn.net/HaoChunhui/article/details/470654

版权

程序设计专栏收录该内容

9 篇文章 0 订阅

订阅专栏

    '引用 Microsoft Excel 11.0 Object Library
    Dim xlsApp As Excel.Application
    Dim eworkbook As Workbook
    Dim eworksheet As Worksheet
    Dim rantmp As Range
    Dim rantmp2 As Range
    '判断文件是否存在
    If Dir("F:/Book1.xls") = "" And Dir("F:/Book2.xls") = "" Then
        MsgBox "F:/Book1.xls 不存在。" & vbCrLf & "F:/Book2.xls", vbInformation, "Error"
    ElseIf Dir("F:/Book1.xls") = "" Then
        MsgBox "F:/Book1.xls 不存在。", vbInformation, "Error"
    ElseIf Dir("F:/Book2.xls") = "" Then
        MsgBox "F:/Book2 不存在。", vbInformation, "Error"
    Else
        '复制
        Set xlsApp = New Excel.Application
        Set eworkbook = xlsApp.Workbooks.Open("F:/Book1.xls")
        Set eworksheet = eworkbook.Sheets("Sheet1")
        Set rantmp = eworksheet.Range("A1:A8")
        rantmp.Copy

        '粘贴
        Set eworkbook = xlsApp.Workbooks.Open("F:/Book2.xls")
        Set eworksheet = eworkbook.Sheets("Sheet1")
        Set rantmp2 = eworksheet.Range("B9:B16")
        eworksheet.Range("B9:B16").Select
        ActiveSheet.Paste
        '关闭
        eworkbook.Save
        eworkbook.Close
        xlsApp.Quit
    End If