1

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
Community
  • 1
  • 1
  • Avoid using `.Select`, `.Activate`, `ActiveSheet.`, `ActiveWorkbook` and `Windows` these cause many issues and you can write your code completely without using them. • You might benefit from reading [How to avoid using Select in Excel VBA](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba). – Pᴇʜ Mar 08 '19 at 07:23

1 Answers1

1

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
Robert Mearns
  • 11,796
  • 3
  • 38
  • 42
GMalc
  • 2,608
  • 1
  • 9
  • 16
  • its not working as per my requirement.. please help with a macro which opens all excel files from a path where macro enabled excel is located and select a particular sheet with name b2b in all excel files, copy all the data and paste it to Sheet1 of macro file and than copy the data of b2b sheet of other opened excel file and paste it to next empty cell. At last close all the sheet except macro enabled sheet – Rohit Khandelwal Mar 09 '19 at 13:47
  • Because you needed to change the `Filename` to the directory you want to loop through. Replace `Filename = Dir("C:\Users\You\Documents\Test\*.xksx")` with `Filename = Dir(ThisWorkbook.Path & "\*.xlsx")` – GMalc Mar 11 '19 at 15:23