Open and copy data to another file for a table style using a macro in an excel report

One thing I like to do, it is to extract the data and from my report, I just run a macro to open and copy the data extracted from the new file to paste them into my report, this code works only if I use the “format as table” function giving it a “table style”. I will tell you how to do it for 1 and 2 extracted excel file into 1 single report.

macro excel macro excel
macro excel macro excel

 

When I use the macro ?

To open/copy new data file into my report automatically only when I used the table style option.

 

How to create the macro ?

Read How to create, edit, hide and select a macro in an excel report

 

How to create the button to associate it with the macro ?

Read How to create a button and associated it to a macro in an excel report

 

How is the macro ?

Copy the code below and paste it into your macro. You will see my comments in green if exist so follow the help to adapt to your need.

Copy from 1 file to paste to 1 file:

Sub test()
Dim i As Workbook
Dim x As Workbook
' change book1.xlsx by the name of your file where to copy the data
' if in another folder, put Workbooks.Open("\\fullpath\Book1.xlsx")
Set i = Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx")
' change book2.xlsm by the name of your file where to paste the data
Set x = Workbooks("Book2.xlsm")
' change Sheet1 name by your name sheet and A2:D20 by the cell area where to copy the data
i.Worksheets("Sheet1").Range("A2:D20").Copy
' change Sheet1 name by your name sheet and A2 by the cell where you want to paste the data
x.Worksheets("Sheet1").Range("A2").PasteSpecial (xlPasteValues)
Application.DisplayAlerts = False
i.Close
End Sub

Copy from 2 files to paste to 1 file:

Sub test()
Dim i As Workbook
Dim j As Workbook
Dim x As Workbook
' change book1.xlsx by the name of your first file where to copy the data
Set i = Workbooks.Open(ThisWorkbook.Path & "\Book1.xlsx")
' change book2.xlsx by the name of your second file where to copy the data
Set j = Workbooks.Open(ThisWorkbook.Path & "\Book2.xlsx")
' change book3.xlsm by the name of your file where to paste the data
Set x = Workbooks("Book3.xlsm")
' change Sheet1 name by your name sheet and A2:D20 by the cell area where to copy the data of your first file
i.Worksheets("Sheet1").Range("A2:D20").Copy
' change Sheet1 name by your first name sheet and A2 by the cell where you want to paste the data
x.Worksheets("Sheet1").Range("A2").PasteSpecial (xlPasteValues)
' change Sheet1 name by your name sheet and A2:D20 by the cell area where to copy the data of your second file
j.Worksheets("Sheet1").Range("A2:D20").Copy
' change Sheet2 name by your second name sheet and A2 by the cell where you want to paste the data
x.Worksheets("Sheet2").Range("A2").PasteSpecial (xlPasteValues)
Application.DisplayAlerts = False
i.Close
j.Close
End Sub

To paste the data below the existing data, I just have to add 2 new lines and to replace 1 existing line:

Sub test()
' add this line just below the last dim
Dim LastRow As Long
' add this line just below the last set and update sheet1 name for 1 file to copy
' add this line just below the first x.Worksheets and update sheet1 name for 2 files to copy
LastRow = x.Worksheets("Sheet1").Range("A:A").End(xlDown).Offset(1).Row
' replace this line by the one just before application and update sheet1 name
x.Worksheets("Sheet1").Cells(LastRow, 1).PasteSpecial (xlPasteValues)
End Sub
macro excel macro excel

Interesting Management