使用命令按钮将数据从一个工作簿发送到另一个工作簿

时间:2016-10-14 16:07:50

标签: excel-vba vba excel

我有以下代码,使用命令按钮将数据从一个工作簿发送到另一个工作簿中的特定单元格。这在我最初测试时起作用,但在我做了两件事之后:在整个工作簿中的其他命令按钮中粘贴了相同的代码和更新的单元格引用,并更改了打开的工作簿"指令"如果"命令试图考虑已经打开的目标工作簿,我开始得到一个"下标超出范围"信息。你能帮忙吗?

picker.delegate = self

1 个答案:

答案 0 :(得分:0)

我更容易指出代码中的缺陷,而不是要求一堆问题来修复它。请查看我在您的代码中包含的评论:

Dim wkbDest, wkbSource As Workbook '<--- wkbDest is Variant here.
    ret = ("<insert file path here>")
    If ret = False Then '<-- might not be wrong, but why is this boolean?
        Set wkbDest = Workbooks.Open("<insert file path here>")
    Else
        Set wkbDest = Workbooks("<insert file name here>")
    End If
    Set wkbSource = ThisWorkbook
Dim f As Range, rwNum '<--- rwNum is Variant
    Set f = wkbDest.Worksheets("Exhibit C").Range("B:B").Find(What:=wkbSource.Worksheets("ReferenceData1").Range("S3"), lookat:=xlWhole) '<----don't use Worksheets, use Sheets()

If Range("C19").Value = "Pass" Then '<---- you aren't defining where this range is (which workbook, which sheet)
    wkbDest.Worksheets("Exhibit C").Cells(f.Row, "E").Value = Range("B19").Value '<-----what if 'f' isn't found? you have nothing to catch that
ElseIf Range("C19").Value = "Fail" Then '<----- you need to define this range as well

End If

这是我改变代码的方式。 (删除ret)

Sub SendData()
    Dim wbSource As Workbook: Set wbSource = ThisWorkbook
    Dim wbPath As String: wbPath = "C:\ExampleFolder"
    Dim wbDestName As String: wbDestName = "ExampleWorkbook.xls"
    Dim wbDest As Workbook: Set wbDest = Workbooks(wbDestName)
    Dim f As Range

    Application.ScreenUpdating = False

    'Verify workbook exists at target loctation and open it
    If wbDest Is Nothing Then
        If Right(wbPath, 1) <> "\" Then wbPath = wbPath & "\"
        If Dir(wbPath & wbDestName) = "" Then
            MsgBox "Workbook " & wbDest & " at location " & wbPath & " could not be found.", _
                vbCritical, "Missing Workbook"
            Exit Sub
        Else: Set wbDest = Workbooks.Open(wbPath & wbDestName)
        End If
    End If

    Set f = wbDest.Sheets("Exhibit C").Range("B:B").Find(What:=wbSource.Sheets("ReferenceData1").Range("S3").Value, LookAt:=xlWhole)

    'If f is found, do stuff, otherwise exit
    If Not f Is Nothing Then
        If UCase(wbSource.Range("C19").Value) = UCase("Pass") Then
            wbDest.Sheets("Exhibit C").Cells(f.Row, "E").Value = wbSource.Range("B19").Value
        ElseIf UCase(wbSource.Range("C19").Value) = UCase("Fail") Then
            'some fail code
        End If
    Else: MsgBox "Could not find " & wbSource.Sheets("ReferenceData1").Range("S3").Value, vbCritical, "No Search Result"
    End If

    wbDest.Save
    wbDest.Close

    Application.ScreenUpdating = True
End Sub