Копирование и вставка данных из многих рабочих книг VBA

Question

Я пишу код для циклического просмотра множества книг в папке, выбора пути к файлу и копирования данных из каждой книги в основной файл.

Ниже приведен код, который я использовал, но есть ошибка «Wend Without While».Кто-то, пожалуйста, помогите мне проверить и дайте мне знать, если это правильно.Я новичок в VBA и пытаюсь учиться.

Спасибо.

Sub loopAllSubFolderSelectStartDirectory()

'Another Macro must call LoopAllSubFolders Macro to start to procedure
Call LoopAllSubFolders("C:\Users\BAO LOC TRAN\Downloads")

End Sub

'List all files in sub folders
Sub LoopAllSubFolders(ByVal folderPath As String)

Dim fileName As String
Dim fullFilePath As String
Dim numFolders As Long
Dim folders() As String
Dim ClaimNo() As String
Dim NextRow As String

Dim i As Long

 'Optimize Macro Speed

    Application.ScreenUpdating = False
    Application.EnableEvents = False

'   Put column headings on active sheet
    Cells(1, 1) = "Path"
    Cells(1, 2) = "Claim Number"
    Range("A1:B1").Font.Bold = True


If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"

fileName = Dir(folderPath & "*.*", vbDirectory)

While Len(fileName) <> 0

    If Left(fileName, 1) <> "." Then

        fullFilePath = folderPath & fileName

        If (GetAttr(fullFilePath) And vbDirectory) = vbDirectory Then
            ReDim Preserve folders(0 To numFolders) As String
            folders(numFolders) = fullFilePath
            numFolders = numFolders + 1
        Else
            'Insert the actions to be performed on each file
            'This example will print the full file path to the immediate window
            Debug.Print folderPath & fileName
        End If

    End If

         'Write the path and file to the sheet

        Cells(WorksheetFunction.CountA(Range("A:A")) + 1, 1) = fullFilePath

Wend
        'Copy Claim Number

Do While fileName <> ""

     Dim Openworkbook As Workbook

        Set Openworkbook = Workbooks.Open(folderPath & fileName)

        Openworkbook.Worksheets(1).Active

        Range(Cells(14, 4)).Copy

        NextRow = Range("B:B" & Rows.Count).End(xlUp).Row + 1

        Cells(NextRow, 2).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

        Openworkbook.Close SaveChanges:=False

    fileName = Dir()

Wend

For i = 0 To numFolders - 1

    LoopAllSubFolders folders(i)

Next i

MsgBox "Task Complete!"

ResetSettings:
'Reset Macro Optimization Settings

    Application.EnableEvents = True
    Application.ScreenUpdating = True

End Sub