打开与活动工作簿EXCEPT活动工作簿相同的文件夹中的所有文件

我正在使用一个macros打开每个Excel文件在相同的文件夹中，该工作簿包含macros（我称之为主工作簿），并复制第一个电子表格中的所有数据，然后将其粘贴到主工作簿上一个新的工作表。 我在网上发现了一些非常有用的代码，我做了一些更改。 一切似乎工作正常，除了这段代码打开文件夹中的每个文件（在Do Until循环），它打开了一半。

我希望能够避免这种情况，直接引用主电子表格名称，以防有人重命名。

是否有一个简单的命令会跳过循环中的其余代码，如果它试图打开自己？

代码如下：

Sub CombineWSs() Dim wbDst As Workbook Dim wbSrc As Workbook Dim wsSrc As Worksheet Dim MyPath As String Dim strFilename As String Application.DisplayAlerts = False Application.EnableEvents = False Application.ScreenUpdating = False MyPath = ThisWorkbook.Path Set wbDst = ThisWorkbook strFilename = Dir(MyPath & "\*.xls", vbNormal) If Len(strFilename) = 0 Then Exit Sub Do Until strFilename = "" Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename) Set wsSrc = wbSrc.Worksheets(1) 'copy the data wbSrc.ActiveSheet.UsedRange.Select Selection.Copy 'create a new worksheet in this master file wbDst.Sheets.Add After:=Sheets(Sheets.Count) 'paste the data into master file's new sheet wbDst.Sheets(wbDst.Worksheets.Count).Range("A1").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True wbSrc.Close False strFilename = Dir() Loop wbDst.Worksheets(1).Delete Application.DisplayAlerts = True Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

Answer 1

在我们的循环中放置一个If块

 Do Until strFilename = "" If strFilename <> wbDest.Name Then 'since you already set wbDest = ThisWorkbook '... rest of code End If Loop