VBA Excelをスキップしてもスキップした理由

Question

"Excel, loop through XLSM files and copy row to another sheet"のサンプルコードを使用して、以下に示すExcelマクロを作成しました。 ThisWorkbookと同じフォルダ内のいくつかの.xlsmファイルをループし、各.xlsmファイルから "Summary2"という名前のシートの列C、D、Eからすべてを引き出す必要があります。それらはThisWorkbookの列C、DおよびEにコピーされ、フォルダ内の各ファイルのファイル名は、それに付随するデータの横に（Col 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 

私はこのマクロを実行するとdo whileループはスキップされますと、私はその理由は分かりません。また、1つのセルにすべてのセルをコピーして貼り付けるより良い方法があれば、それを聞いてうれしいです。

Answer 1

あなたのDOでこれを試してみてください

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 

は、あなたが一度にすべてを行うにしたい場合は一方で、あなたは、配列を埋めるし、新しいワークシートに、配列の内容をダンプする必要があります。たくさんのワークブックを検索していると、あなたが持っているように一度に1つずつ行うのは永遠にかかるでしょう。コピーの代わりにも

&貼り付け、あなただけのNewCell.value = OldCell.Value言うことができ