同路径下工作簿指定工作表汇总到工作簿中出现屎循环，求救！！！

a362126101

Sub 合并工作簿()
    Dim MyFile, MyName, P As String
    Application.ScreenUpdating = False
    P = ThisWorkbook.Path
    MyFile = Dir(P & "\" & "*.xlsm")
    Do While MyFile <> ""
        If MyFile <> ThisWorkbook.Name Then
            Workbooks.Open (P & "\" & MyFile)

            ActiveWorkbook.Sheets("产品结构").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

            Workbooks.Open(P & "\" & MyFile).Close False
            MyFile = Dir
        End If
    Loop
    Application.ScreenUpdating = True
End Sub

xuanmuluck

没人吗？？？？？？？？？？

iam46

代码这里有问题，
Workbooks.Open (P & "\" & MyFile)
            ActiveWorkbook.Sheets("产品结构").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)

activeworkbook和thisworkbook对象都是当前打开的汇总表工作簿，当然会死循环了。
解决方案见上一篇帖子。大体是这样，
wb=Workbooks.Open (P & "\" & MyFile)
wb.Sheets("产品结构").Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
wb.close false