求助各位大神
Sub 复制工作簿()
Application.Screenupdating = Dalse
Dim Erow As Long, wt As Worksheet, mz As String, sht As Worksheet, wb As Workbook, arr As Variant, AB AS Long, ABC As Long, allfilename As Variant,openfile As Variant
allfilename = Application.GetOpenFilename(FILEFILTER:="所有文件,*.*,Excel文件,*.xls;*.xlsx*.xlsm",Title:="选择要复制的工作簿",Multiselect:=True)'选择文件
Set wt = ThisWorkbook.Worksheets(1)
For Each openfile In allfilename
If openfile <> False Then
Set wb = Workbooks.Open(openfile)
FOR Each sht In wb.Worksheets
Erow = wt.Range("A1048576").End(xlUp).Row + 1
If sht.Visible = True Then
arr = sht.Range("A1:z" & (sht.Range("a1048576").End(xlUp).Row))
wt.Cells(Erow, "A").Resize(UBound(arr,1), UBound(arr,2)) = arr
End If
Next
wb.Close False
End If
Next
Application.ScreenUpdating = True
End Sub
报错1004 但是我的宏信任启用所有宏也信任了模型访问,报错出在两台电脑上,一台报错 Set wb = Workbooks.Open(openfile) 方法range作用于对象open时失败,但是这个能运行,12个表合并了7个
另一台电脑报错 FOR Each sht In wb.Worksheets,报错后一个文件都没有合并
求助怎么解决
Sub 复制工作簿()
Application.Screenupdating = Dalse
Dim Erow As Long, wt As Worksheet, mz As String, sht As Worksheet, wb As Workbook, arr As Variant, AB AS Long, ABC As Long, allfilename As Variant,openfile As Variant
allfilename = Application.GetOpenFilename(FILEFILTER:="所有文件,*.*,Excel文件,*.xls;*.xlsx*.xlsm",Title:="选择要复制的工作簿",Multiselect:=True)'选择文件
Set wt = ThisWorkbook.Worksheets(1)
For Each openfile In allfilename
If openfile <> False Then
Set wb = Workbooks.Open(openfile)
FOR Each sht In wb.Worksheets
Erow = wt.Range("A1048576").End(xlUp).Row + 1
If sht.Visible = True Then
arr = sht.Range("A1:z" & (sht.Range("a1048576").End(xlUp).Row))
wt.Cells(Erow, "A").Resize(UBound(arr,1), UBound(arr,2)) = arr
End If
Next
wb.Close False
End If
Next
Application.ScreenUpdating = True
End Sub
报错1004 但是我的宏信任启用所有宏也信任了模型访问,报错出在两台电脑上,一台报错 Set wb = Workbooks.Open(openfile) 方法range作用于对象open时失败,但是这个能运行,12个表合并了7个
另一台电脑报错 FOR Each sht In wb.Worksheets,报错后一个文件都没有合并
求助怎么解决