VBA Excel DO跳过，不确定为什么

我写了一个Excelmacros，如下所示，使用“Excel中的一些示例代码，通过XLSM文件循环并将行复制到另一个表” 。 它应该通过与ThisWorkbook相同的文件夹中的一些.xlsm文件进行循环，从每个.xlsm文件的名为“Summary2”的表中抽取列C，D和E中的所有内容。 这些应该被复制到ThisWorkbook列C，D和E中，并且文件夹中的每个文件的文件名应该出现在（在列B中）伴随它的数据旁边。

 Sub Summarize() Dim SummaryWkb As Workbook, SourceWkb As Workbook Dim SummarySheet As Worksheet, SourceWks As Worksheet Dim FolderPath As String Dim FileName As Variant Dim NRow As Long Dim LRow As Long Dim LastRow As Long Set SummaryWkb = ThisWorkbook Set SummarySheet = SummaryWkb.Worksheets(1) SummarySheet.Name = "Summary" FolderPath = SummaryWkb.Path FileName = Dir(FolderPath) NRow = 2 Do While (FileName <> "") Set SourceWkb = Workbooks.Open(FolderPath & FileName) Set SourceWks = SourceWkb.Sheets("Summary2") 'File Name Copy SummarySheet.Range("B" & NRow) = FileName NRow = NRow 'Data Copy LastRow = SourceWks.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row LRow = NRow + LastRow SourceWks.Range("C2:C" & LastRow).Copy SummarySheet.Range("C" & NRow & ":C" & LRow).PasteSpecial xlPasteValues SourceWks.Range("D2:D" & LastRow).Copy SummarySheet.Range("D" & NRow & ":D" & LRow).PasteSpecial xlPasteValues SourceWks.Range("E2:E" & LastRow).Copy SummarySheet.Range("E" & NRow & ":D" & LRow).PasteSpecial xlPasteValues SourceWkb.Close False NRow = NRow + LastRow + 1 FileName = Dir() Loop SummarySheet.Range("B1") = "Source" SummarySheet.Range("C1") = "Machine" SummarySheet.Range("D1") = "Quantity" SummarySheet.Range("E1") = "Ranking" SummarySheet.Columns.AutoFit SummaryWkb.Save MsgBox "Summary Successfully Created!", vbInformation Set SourceWkb = Nothing Set SourceWks = Nothing Set SummarySheet = Nothing Set SummaryWkb = Nothing End Sub 

当我运行这个macros时， do while循环被跳过，我不知道为什么。 另外，如果有更好的方法来复制和粘贴所有的细胞，我很乐意听到它。

Answer 1

试试这个和你一起做吧

  path = "path2folder" & "\" Filename = Dir(path & "*.xl??") Do While Len(Filename) > 0 DoEvents Set wbk = Workbooks.Open(path & Filename, True, True) 'add your code wbk.Close False Filename = Dir Loop 

如果您想要一劳永逸，您需要填充数组，然后将数组的内容转储到新的工作表中。 像你一样一次做一个，如果你通过大量的工作簿search，将永远占用一个。

而不是复制和粘贴，你可以只说NewCell.value = OldCell.Value