[已解决]复制选取到多工作簿相应位置出错

果冻的心

运行报错，请帮忙修改
Sub TEST()  '特殊复制
    Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择目标文件夹：", &H1)
    If Not Mapp Is Nothing Then
        M = Mapp.self.Path & "\"
    Else
        MsgBox "你没有选择文件夹！": Exit Sub
    End If
    Set Mycell = Application.InputBox(prompt:="请选择需要复制的区域", Type:=8)
    ADDR = Mycell.Address
    FIL = Dir(M & "*.*")
    Do While FIL <> ""
        With Workbooks.Open(M & FIL).Sheets("表一工程结算")
            Mycell.Copy .Range(ADDR)
            .Range(ADDR).Select
            Selection(4) = Selection(4).Value
        End With
        ActiveWorkbook.Close True
        FIL = Dir
    Loop
    MsgBox "复制完毕！"
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2022-6-1 08:55

Sub TEST()  '特殊复制
    Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择目标文件夹：", &H1)
    If Not Mapp Is Nothing Then
        M = Mapp.self.Path & "\"
    Else
        MsgBox "你没有选择文件夹！": Exit Sub
    End If
    Set Mycell = Application.InputBox(prompt:="请选择需要复制的区域", Type:=8)
    ADDR = Mycell.Address
    FIL = Dir(M & "*.*")
    Do While FIL <> ""
        With Workbooks.Open(M & FIL).Sheets("表一工程结算")
            Mycell.Copy .Range(ADDR)
            .Select
            .Range(ADDR).Select
            Selection(4) = Selection(4).Value
        End With
        ActiveWorkbook.Close True
        FIL = Dir
    Loop
    MsgBox "复制完毕！"
End Sub

跳转到最佳答案楼层

zjdh

Sub TEST()  '特殊复制
    Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择目标文件夹：", &H1)
    If Not Mapp Is Nothing Then
        M = Mapp.self.Path & "\"
    Else
        MsgBox "你没有选择文件夹！": Exit Sub
    End If
    Set Mycell = Application.InputBox(prompt:="请选择需要复制的区域", Type:=8)
    ADDR = Mycell.Address
    FIL = Dir(M & "*.*")
    Do While FIL <> ""
        With Workbooks.Open(M & FIL).Sheets("表一工程结算")
            Mycell.Copy .Range(ADDR)
            .Select
            .Range(ADDR).Select
            Selection(4) = Selection(4).Value
        End With
        ActiveWorkbook.Close True
        FIL = Dir
    Loop
    MsgBox "复制完毕！"
End Sub

果冻的心

zjdh 发表于 2022-6-1 08:55
Sub TEST()  '特殊复制
    Set Mapp = CreateObject("Shell.Application").BrowseForFolder(0, "请选择目 ...

多谢多谢，不知道上次那个怎么突然不行了&#128514;