将文件夹中所有文件的数据复制并粘贴到同一文件夹中的主文件

Question

我正在尝试从一个文件夹中名为“RCR Schedule C - Rate Card.xls”的 3 个不同工作表中的 SAME 选项卡 d. Rate Card 复制特定范围的数据，然后粘贴到名为“RFP 合并宏”的主文件中。 我创建了循环，并且能够从文件夹中的第一个文件复制/粘贴，但不能从其他 2 个文件复制/粘贴。下面是它的代码。有什么方法可以确保代码适用于文件夹中的所有文件，而不仅仅是第一个文件？

Private Sub CommandButton2_Click()
Dim MyFile As String
Dim erow

MyFile = Dir("c:\Users\s4043091\Desktop\New folder\RFP\NEW\")

Do While Len(MyFile) > 0
If MyFile = "RFP consolidation macro.xlsm" Then
Exit Sub
End If

'Workbooks.Open ("c:\Users\s4043091\Desktop\New folder\RFP\NEW\RCR Schedule C - Rate Card.xls")

Workbooks("RCR Schedule C - Rate Card.xls").Worksheets("d. Rate Card").Range("b3:ah482").Copy _
  Workbooks("RFP consolidation macro.xlsm").Worksheets("Masterfile-Rate Card").Range("b1")

Workbooks("RCR Schedule C - Rate Card.xls").Worksheets("a. Company Background").Range("e7").Copy _
  Workbooks("RFP consolidation macro.xlsm").Worksheets("Masterfile-Rate Card").Range("a4:a482")

'Range("A2:D200").Copy
'ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, "a").End(xlUp).Offset(1, 0).Row
'ActiveSheet.Paste Destination:=Worksheets("Macro").Range(Cells(erow, 1), Cells(erow, 1))

MyFile = Dir

Loop

End Sub

Answer 1

未经测试，但这应该可以帮助您：

Option Explicit

Public Sub LoopFilesInFolderEarlyFSO()
    'Early Bound - requires Reference to Microsoft Scripting Runtime; with the reference there is Intellisense
    'the Early Bound part:
    Dim FSO As FileSystemObject
    Set FSO = New FileSystemObject

    'Everything after is the same:
    Dim myFolderPath As String
    myFolderPath = "C:\thePath"
    If FSO.FolderExists(myFolderPath) Then
        Dim myFolder As Folder
        Set myFolder = FSO.GetFolder(myfoderpath)
    Else
        GoTo ExitSub
    End If
    Dim currFile As File
    For Each currFile In myFolder.Files
        Debug.Print currFile.Name
    Next
ExitSub:

End Sub
Public Sub LoopFilesInFolderLateFSO()
    'Late Bound - requires Creating the FSO; without the reference there is no Intellisense

    'the Late Bound part:
    Dim FSO As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")

    'Everything after is the same:
    Dim myFolderPath As String
    myFolderPath = "C:\thePath"
    If FSO.FolderExists(myFolderPath) Then
        Dim myFolder As Folder
        Set myFolder = FSO.GetFolder(myfoderpath)
    Else
        GoTo ExitSub
    End If
    Dim currFile As File
    For Each currFile In myFolder.Files
        Debug.Print currFile.Name
    Next
ExitSub:

End Sub