从许多工作簿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