宏未执行的部分代码

时间:2018-08-07 16:23:30

标签: excel vba excel-vba

非常感谢您的帮助!不幸的是,我测试了您的代码,并收到以下错误消息:运行时错误9下标超出范围

实际上,这行似乎引起了问题:Set wbThis = ThisWorkbook由于此问题,似乎在当前工作簿中无法识别“ Sheet1”(我通过即时窗口中的调试打印对其进行了检查),我咨询了以下主题:Subscript out of range when referencing a worksheet in another workbook from a variable。这就是为什么我通过“ Set wbThis = ActiveWorkbook”修改“ Set wbThis = ThisWorkbook”的原因在执行了此修改并执行了宏之后(这次我没有收到任何错误消息),excel文件“ Parc Vehicule Template.xls”打开了但是指令rng.Copy wsThat.Range(“ A1”)尚未执行,这意味着我的数据尚未从打开的初始工作簿复制到其他工作簿“ Parc Vehicule Template.xls”

非常感谢您的帮助。哈维

1 个答案:

答案 0 :(得分:1)

设置对象,然后使用它们。您的生活将变得非常轻松。如果我要做同样的事情,我会这样做...

这是您要尝试的吗? (未测试

Sub copysheet1tofileParcVehiculeTemplatefortherest()
    Dim wbThis As Workbook, wbThat As Workbook
    Dim wsThis As Worksheet, wsThat As Worksheet
    Dim rng As Range
    Dim fName As String

    Set wbThis = ThisWorkbook
    Set wsThis = wbThis.Sheets("Sheet1")
    Set rng = wsThis.Range("A1:AZ10000")

    fName = "\\ingfs05\data1\GBS Center \52 Migration\ Files\Parc auto Template.xls"

    If Not IsWorkBookOpen(fName) Then
        Set wbThat = Workbooks.Open(fName)
        Set wsThat = wbThat.Sheets("PV template for the rest")
        rng.Copy wsThat.Range("A1")
    End If
End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function

我还发现FnameWorkbooks("Parc Vehicule Template.xls")是不同的。如果这是故意的,那么我猜您正在尝试吗?

Sub copysheet1tofileParcVehiculeTemplatefortherest()
    Dim wbThis As Workbook, wbThat As Workbook, wbTmplt As Workbook
    Dim wsThis As Worksheet, wsThat As Worksheet
    Dim rng As Range
    Dim fName As String

    Set wbThis = ThisWorkbook
    Set wsThis = wbThis.Sheets("Sheet1")
    Set rng = wsThis.Range("A1:AZ10000")

    fName = "\\ingfs05\data1\GBS Center \52 Migration\ Files\Parc auto Template.xls"

    If Not IsWorkBookOpen(fName) Then
        Set wbTmplt = Workbooks.Open(fName)
        Set wbThat = Workbooks("Parc Vehicule Template.xls")
        Set wsThat = wbThat.Sheets("PV template for the rest")
        rng.Copy wsThat.Range("A1")
    End If
End Sub

Function IsWorkBookOpen(FileName As String)
    Dim ff As Long, ErrNo As Long

    On Error Resume Next
    ff = FreeFile()
    Open FileName For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    On Error GoTo 0

    Select Case ErrNo
    Case 0:    IsWorkBookOpen = False
    Case 70:   IsWorkBookOpen = True
    Case Else: Error ErrNo
    End Select
End Function