简体   繁体   中英

Open all excel files in a folder and copy particular file

How can I

  • open all Excel files from a path where a macro enabled Excel file is located
  • select a particular sheet with name b2b in all Excel files
  • copy all the data and paste it to Sheet1 of macro file
  • copy the data of each b2b sheet of other opened Excel files and paste it to next empty cell
  • close all the files except the macro enabled file

The incomplete macro which works only for specified files and location.

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

It should look something like this:

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\*.xlsx")
    
    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

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM