Скопируйте и вставьте данные из всех файлов в папке в основной файл в той же папке - PullRequest
Новая
       31

Скопируйте и вставьте данные из всех файлов в папке в основной файл в той же папке

0 голосов
/ 05 февраля 2020

Я пытаюсь скопировать указанный диапазон c данных из одной и той же вкладки d. Rate Card в 3 различных рабочих листах с именем «Расписание RCR C - Rate Card.xls» в одну папку и вставить в главный файл с именем «RFP». макрос консолидации ". Я создал l oop и могу копировать / вставлять из 1-го файла в папке, но не из другого 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

1 Ответ

0 голосов
/ 06 февраля 2020

Не проверено, но это должно помочь вам: 

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
...