Do While Looping

Question

Ich habe diesen Code unten, der 200 + Dateien auf C: Laufwerk ...... dann suche ich nach Werten beginnend bei Zeile 3 .... Blick auf Col P .... .COL P enthält Werte? "Ja" dann kopiere ganze Zeile ..... (wenn es einen Wert P col in irgendeiner Zelle gibt ... dann merkt es es) .... geht zu dieser Reihe von col P ..... kopiert ganze Reihe abhängig von col P-Werten .... (wenn Wert vorhanden ist, schnappt die Zeile basierend auf Col P in C-Laufwerksdateien) und kopiert diese Zeile nur in eine neue Datei ..... auf dem Desktop ... schließt diese Desktop-Datei und bewegt sich zur nächsten Dateizeile, die nach Daten in Col P sucht .... um Zeile in Desktopdatei zu kopieren ... immer wieder ............. Ich kann es nicht zur nächsten Datei verschieben oder der nächste rekonfigurierte Wert in P col von C-Dateien ....... macht nur EINE Datei ..... benötigt es, um zum nächsten im Stapel von 200 Dateien in C-Laufwerk zu gehen, wobei jede Zeile nach dem Wert in Col gesucht wird P .... kopiere die ganze Zeile und füge sie zu der Desktop-Datei hinzu, wo der erste Datenpunkt gleich unter dem letzten Datenpunkt ist (funktioniert das) Am Ende gibt es mir eine msg-Box, die sagt "x Anzahl der Dateien gesucht "Das meiste funktioniert. Kann herausfinden, wo meine "nächste" sollte entsprechend meiner For-Anweisung gehen ..nor kann ich herausfinden, wo mein Loop sollte für entweder "Do" Anweisung gehen (tun, während und bis) Ich denke, ich habe zu viel los .. ... bitte helfe richtig Danke.

Sub copy_to_new_sheet_clump() 
Dim wbk As Workbook 
Dim filename As String 
Dim path As String 
Dim count As Integer 
path = "C:\Ben_Excel4\" 
filename = Dir(path & "*.xls*") 
'-------------------------------------------- 
'OPEN EXCEL FILES 
Do Until Len(filename) > 0 'IF NEXT FILE EXISTS THEN 
count = count + 1 ' this is to count all files for msg box at end 
Set wbk = Workbooks.Open(path & filename) ' looking in 200+ files in C: 

'assuming the data being searched for is in Equipment Sheet 
Sheets("Equipment").Select ' this is correct sheet for 200+ files in C: 
' get end of rows/number of rows to look at by looking down COL P to end 
rowCount = Cells(Cells.Rows.count, 1).End(xlUp).row 

For i = 3 To rowCount ' starting at row three search P column for data 
         'assuming the number is contained in a cell on COL P 
Range("P" & i).Select 
ActiveCell.Select 
'have data and find bottom of active sheet and paste one row below last data pasted 
Application.ScreenUpdating = False 

Do While ActiveCell.Value <> Empty 

Selection.EntireRow.Select 
' there are hyperlinks have to get rid of on the sheet...ha...dont ask. 
Selection.Hyperlinks.Delete 

Selection.EntireRow.Copy 'copy whats found in Col P 

Application.ScreenUpdating = False 
'saves to desk top file where all the rows for files searched that have data 
' in col P and stacks it nicely in this Book1.xls on desktop sheet 1   

Workbooks.Open ("C:\Users\patrickf\Desktop\Book1.xlsx") 
Sheets("Sheet1").Activate 
Range("A4").Select 'starts at row 4 for pasting 
rowCount = Cells(Cells.Rows.count, "A").End(xlUp).row 
Sheets("Sheet1").Range("a" & rowCount + 1).Select 
ActiveSheet.PastE 
Application.ScreenUpdating = False 
ActiveWorkbook.SaveAs filename:="C:\Users\patrickf\Desktop\Book1.xlsx", _ 
FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False 
ActiveWindow.Close 'saves desktop file and closes it.... 
Application.ScreenUpdating = False 
Exit Do 

Application.ScreenUpdating = False 


Application.ScreenUpdating = False 
Loop 

MY ISSUE = 'somehow need it to go to NEXT file in C drive out of the 200 
      ' sitting there and search by Col P for "not empty" ....grab 
      ' row...paste to desktop file....then next file. 

MsgBox count & " : files found in folder" 

Answer 1

Ungeprüfte sollte aber mehr oder weniger da sein:

Sub copy_to_new_sheet_clump() 

    'use a constant for fixed values 
    Const FOLDER As String = "C:\Ben_Excel4\" 
    Const SHT_SOURCE As String = "Equipment" 
    Const WB_DEST As String = "C:\Users\patrickf\Desktop\Book1.xlsx" 
    Const SHT_DEST As String = "Sheet1" 

    Dim wbk As Workbook, f As String, shtSrc As Worksheet 
    Dim count As Integer, wbDest As Workbook, rngDest As Range 
    Dim i As Long 

    Set wbDest = Workbooks.Open(WB_DEST) 

    'set the first destination row 
    Set rngDest = wbDest.Sheets(SHT_DEST).Cells(Rows.count, 1).End(xlUp).Offset(1, 0) 
    count = 0 

    f = Dir(FOLDER & "*.xls*") 
    Do While Len(f) > 0 

     Set wbk = Workbooks.Open(FOLDER & f, ReadOnly:=True) 
     Set shtSrc = wbk.Sheets(SHT_SOURCE) 

     For i = 3 To shtSrc.Cells(shtSrc.Rows.count, 1).End(xlUp).Row 
      With shtSrc.Rows(i) 
       'any value in Col P ? 
       If .Cells(1, "P").Value <> "" Then 
        .Hyperlinks.Delete 
        .Copy rngDest      'copy the row 
        Set rngDest = rngDest.Offset(1, 0) 'next paste row in destination sheet 
       End If 
      End With 
     Next i 

     wbk.Close False 'no save 

     count = count + 1 
     f = Dir() 'next file (if any) 
    Loop 

    wbDest.Close True 'save changes 

    MsgBox count & " : files found in folder '" & FOLDER & "'" 

End Sub