VBA將代碼從MSG Box更改爲彙總報告

Question

下午好，

我試過搜索不同的論壇無濟於事。

我有下面的VBA代碼，它將遍歷文件夾中的所有文件，並在msge框中生成循環在該文件夾中的每個文件的總行數。

如果可能，我需要您的幫助是生成一份總結報告。

理想

總結報告將顯示文件名，並顯示在列H.與數據有多少行

Sub LoopThroughFiles() 

Dim folderPath As String 

folderPath = ThisWorkbook.Path & "\" 

Filename = Dir(folderPath & "*.xlsx") 

Do While Filename <> "" 
    Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True) 
    For Each sh In wb.Sheets 
     If Application.CountA(sh.Range("H:H")) > 0 Then 
      myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row 
     End If 
    Next 
    wb.Close False 
    Filename = Dir 
    Set wb = Nothing 
Loop 

MsgBox myCount 

End Sub 

Answer 1

你可以嘗試打開所有值都存儲在一個「家」的工作簿。基本上，你需要做的是打開一個新的工作簿，並在你通過每個文件循環時，你將在新的工作簿中粘貼文件路徑和行數。希望這會有所幫助，或者至少讓你知道如何去做你想做的事情。 `

Sub LoopThroughFiles() 

Dim folderPath As String 
Dim summarySheet as Workbook 
set summarySheet = workbook.add 

folderPath = ThisWorkbook.Path & "\" 

Filename = Dir(folderPath & "*.xlsx") 

Do While Filename <> "" 
    Set wb = Workbooks.Open(folderPath & Filename, ReadOnly:=True) 
    For Each sh In wb.Sheets 
     If Application.CountA(sh.Range("H:H")) > 0 Then 
      myCount = myCount + sh.Range("H" & Rows.Count).End(xlUp).Row 
     End If 
    Next 
    wb.Close False 
    summarySheet.activate 
    Range("A:A").insert Shift:=xlDown 
    Cells(1,1) = Filename 
    Cells(1,2) = myCount 
    Filename = Dir 
    Set wb = Nothing 
Loop 

MsgBox myCount 

End Sub`