|
本帖最后由 果冻的心 于 2022-6-1 08:41 编辑
运行报错,请帮忙修改
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
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
|
|