Откройте все файлы Excel в папке и скопируйте определенный файл

Question

Как я могу

• открыть все файлы Excel по пути, где расположен файл Excel с поддержкой макросов
• выберите конкретный лист с именем b2b во всех файлах Excel
• скопируйте все данные и вставьте их в Sheet1 файла макроса
• скопировать данные каждого листа b2b из других открытых файлов Excel и вставить их в следующую пустую ячейку
• закрыть все файлы, кроме файла с поддержкой макросов

Неполный макрос, который работает только для указанных файлов и местоположения.

Sub Step1OpenCopyPaste()
    Dim oCell As Range
    Dim rowCount As Integer
    ' open the source workbook and select the source sheet

    Workbooks.Open Filename:="\e\Rohit\Others\Rahul.xlsx"

    Sheets("B2B").Select

    ' copy the source range

    With Sheets("B2B")
        rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
        'Select.range(a7
    End With

    Selection.Copy

    ' select current workbook and paste the values starting at A1

    Windows("Macro.xlsx").Activate    
    Sheets("Sheet1").Select

    '------------------------------------------------
    With Sheets("Sheet1")
        Set oCell = .Cells(.Rows.Count, 1).End(xlUp)
    End With

    oCell.Select
    '------------------------------------------------

    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveWorkbook.Save


    Workbooks.Open Filename:="\\e\Rohit\Others\Rohit.xlsx"
    Sheets("B2B").Select

    ' copy the source range

    With Sheets("B2B")
        rowCount = .Cells(.Rows.Count, 1).End(xlUp).Row
        .Range(.Cells(1, 1), .Cells(rowCount, 7)).Select
    End With

    Selection.Copy

    ' select current workbook and paste the values starting at A1

    Windows("Macro.xlsx").Activate 
    Sheets("Sheet1").Select

    '------------------------------------------------
    With Sheets("Sheet1")
        Set oCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With

    oCell.Select
    '------------------------------------------------

    ActiveSheet.Paste 
    Application.CutCopyMode = False  
    ActiveWorkbook.Save

    Dim wb As Workbook

    'Loop through each workbook
    For Each wb In Application.Workbooks
        'Prevent the workbook that contains the
        'code from being closed
        If wb.Name <> ThisWorkbook.Name Then        
            'Close the workbook and don't save changes
            wb.Close SaveChanges:=False
        End If
    Next wb
End Sub

Answer 1

Это должно выглядеть примерно так:

Dim Filename As String
Dim lLastRow As Long
Dim wbDst As Workbook, wbSrce As Workbook
Dim wsDst As Worksheet

Set wsDst = ThisWorkbook.Worksheets("Sheet1")
Filename = Dir("C:\Users\You\Documents\Test\*.xksx")

    Do While Filename <> ""
        Set wbSrce = Workbooks.Open(Filename)
        lLastRow = wsDst.UsedRange.Rows.Count + 1
            wbSrce.Sheets("B2B").UsedRange.Copy wsDst.Range("A" & lLastRow)
            wbSrce.Close savechanges:=False
        Filename = Dir
    Loop