Question

我有一张excel表“b.xls”，其中A列和B列的内容如下：

Column A  Column B
C1         F1
C2         F2
C3         Z3

我想将“b.xls”工作簿的工作表“Sheet1”的C1，C2和C3位置的内容复制到工作簿“a.xlsm”的工作表“Sheet1”的位置F1，F2，Z3 我跟随宏观了。在运行类型不匹配时，错误显示在GetData行的srcAddress点。请帮忙

要求是复制数据而不打开b.xls。

Sub Update_Data()
Dim rngA As Range
Dim rngB As Range
Dim srcAddress As Range
Dim destAddress As Range
Dim r As Long   'row iterator
Dim MyPath As String

MyPath = ActiveWorkbook.Path
If Right(MyPath, 1) <> "\" Then
    MyPath = MyPath & "\"
End If
Set rngA = Range("A2", Range("A2").End(xlDown))
Set rngB = rngA.Offset(0, 1)

For r = 1 To rngA.Rows.Count
Set srcAddress = Range(rngA(r).Value)
Set destAddress = Workbooks("a.xlsm").Sheets("Test_data").Range(rngB(r).Value)
GetData MyPath & "b.xls", "Sheet1", srcAddress, destAddress, True, True
'destAddress.Value = srcAddress.Value
Next

End Sub

Answer 1

我刚写了下面的代码 - 但后来读到b.xls不应该被打开，所以它可能不是你想要的。但是，如果您不允许打开b.xls，那么如何在b.xls中访问映射？

无论如何，这是代码，也许你可以使用它的一部分。它会阻止屏幕更新，因此用户不会看到另一个文件被打开：

Sub UpdateData()
    Dim rngSource As Range
    Dim wbTarget As Workbook
    Dim wsTarget As Worksheet

    Application.ScreenUpdating = False 'This will prevent the workbook to be displayed during execution
    On Error Resume Next
    Set wbTarget = Workbooks("a.xls")
    If Err.Number Then
        Err.Clear
        Set wbTarget = Workbooks.Open(YourPath & "a.xls")
    End If

    Set wsTarget = wbTarget.Worksheets("Sheet1")

    With Worksheets("Sheet1")
        For Each rngSource In .Range("A1").Resize(.Range("A" & .Rows.Count).End(xlUp).Row)
            wsTarget.Range(rngSource.Offset(, 1).Value) = .Range(rngSource.Value).Value
        Next
    End With
    wbTarget.Save
    wbTarget.Close

    Application.ScreenUpdating = True
End Sub

宏编译错误

1 个答案: