Question

我希望你能提供帮助。我已经尝试自己编写代码（参见下面的代码），但是失败了，所以我正在向社区寻求帮助。

我需要我的代码做的是允许用户点击命令按钮，然后用户选择一个文件夹。选择此文件夹后。我需要代码查看或循环浏览此文件夹和此文件夹中的所有子文件夹，并找到名称为喜欢“ CustomerExp ”的工作表，然后复制工作表名称中的数据类似于“ CustomerExp ”，从第二行到最后一行，并将信息粘贴到名为“Disputes”的工作表中，其中包含宏。

我提供了图片以便更好地理解。

Pic 1是宏的位置，我需要粘贴的信息。

图1

图2是用户将选择的第一个文件，也是我希望他们选择的唯一文件

图2

图3你可以看到2017文件夹中还有其他几个文件夹

图3

Pic 4再次，你可以看到我们有我想要的文件以及需要循环的更多文件夹

图4

基本上我需要的代码是允许该人选择2017文件夹点击确定，然后代码浏览2017文件夹中的所有内容，找到名称喜欢“ CustomerExp 的文件“将数据和粘贴复制到保存宏的工作表中的”Disputes“工作表。

我的代码编译但它没有做任何事情。一如既往，非常感谢任何和所有的帮助。

我的代码

Sub AllWorkbooks()

    Dim MyFolder As String 'Path collected from the folder picker dialog
    Dim myFile As String 'Filename obtained by DIR function
    Dim wbk As Workbook 'Used to loop through each workbook
    Dim FSO As New FileSystemObject ' Requires "Windows Script Host Object Model" in Tools -> References
    Dim ParentFolder As Object, ChildFolder As Object

    Dim wb As Workbook
    Dim myPath As String    
    Dim myExtension As String
    Dim FldrPicker As FileDialog
    Dim lRow As Long
    Dim ws2 As Worksheet
    Dim y As Workbook

    On Error Resume Next
    Application.ScreenUpdating = False

    'Opens the folder picker dialog to allow user selection
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Please select a folder"
        .Show
        .AllowMultiSelect = False

        If .SelectedItems.Count = 0 Then 'If no folder is selected, abort
            MsgBox "You did not select a folder"
            Exit Sub
        End If    
        MyFolder = .SelectedItems(1) & "\" 'Assign selected folder to MyFolder
    End With

    myFile = Dir(MyFolder) 'DIR gets the first file of the folder        

    Set y = ThisWorkbook
    Set ws2 = y.Sheets("Disputes")

    'Loop through all files in a folder until DIR cannot find anymore
    Do While myFile <> ""

        If myFile Like "*CustomerExp*" Then                                
            'Opens the file and assigns to the wbk variable for future use
            Set wbk = Workbooks.Open(Filename:=MyFolder & myFile)
            'Replace the line below with the statements you would want your macro to perform
            With wb.Sheets(1)
                lRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
            End With

            Application.Wait (Now + TimeValue("0:00:05"))
            wbk.Close savechanges:=True            
        End If
        myFile = Dir 'DIR gets the next file in the folder                               
    Loop

    For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders
        myFile = Dir(MyFolder & ChildFolder.Name) 'DIR gets the first file of the folder
        'Loop through all files in a folder until DIR cannot find anymore
        Do While myFile <> ""

        If myFile Like "*CustomerExp*" Then            
            'Opens the file and assigns to the wbk variable for future use
            Set wbk = Workbooks.Open(Filename:=MyFolder & ChildFolder.Name & "\" & myFile)
            'Replace the line below with the statements you would want your macro to perform
            With wb.Sheets(1)
                lRow = .Range("A" & Rows.Count).End(xlUp).Row
                .Range("A2:M" & lRow).Copy ws2.Range("A" & Rows.Count).End(xlUp)(2)
            End With

            Application.Wait (Now + TimeValue("0:00:05"))
            wbk.Close savechanges:=True
        End If
        myFile = Dir 'DIR gets the next file in the folder
    Loop
Next ChildFolder

Application.ScreenUpdating = True

End Sub

Answer 1

您的代码中只有几个小问题：

1。 With wb.Sheets(1)应为With wbk.Sheets(1)

接着是

lRow = .Range("A" & Rows.Count).End(xlUp).Row应为lRow = .Range("A" & .Rows.Count).End(xlUp).Row

正如@ShaiRado在评论

中已经指出的那样

您必须在两个地方进行上述更改。先进入

Do While myFile <> ""


Loop

然后再次为每个循环执行while while循环

For Each ChildFolder In FSO.GetFolder(MyFolder).SubFolders

Do While myFile <> ""


Loop

Next ChildFolder

2。 myFile = Dir(MyFolder & ChildFolder.Name)应为myFile = Dir(MyFolder & ChildFolder.Name & "\")

VBA循环浏览文件夹和子文件夹以查找特定工作表，然后复制并粘贴某些数据

1 个答案: