VBA Excel DO WHILE übersprungen, nicht sicher warum

Question

Ich schrieb ein Excel-Makro, unten gezeigt, mit einigen Beispielcode aus "Excel, loop through XLSM files and copy row to another sheet". Es sollte einige XLSM-Dateien in demselben Ordner wie durchlaufen, alles aus den Spalten C, D und E in einem Blatt mit dem Namen "Summary2" aus jeder XLSM-Datei ziehen. Diese sollten in die Spalten C, D und E von ThisWorkbook kopiert werden, und der Dateiname jeder Datei in dem Ordner sollte neben (in Spalte B) die Daten erscheinen, die sie begleiten.

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 

Als ich dieses Makro die do while laufen Schleife übersprungen wird, und ich habe keine Ahnung, warum. Auch wenn es einen besseren Weg gibt, alle Zellen auf einmal zu kopieren und einzufügen, würde ich mich freuen, davon zu hören.

Answer 1

versuchen Sie dies mit Ihrem do während

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 

Wenn Sie alles auf einmal tun wollen, müssen Sie ein Array füllen und dann Dump Inhalt eines Arrays in neues Arbeitsblatt. Es wird ewig dauern, wenn du eins nach dem anderen machst, wenn du viele Arbeitsmappen durchsuchst.

auch statt Kopie & Einfügen kann man einfach sagen NewCell.value = OldCell.Value