• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Copy paste from multiple excel file

Abhijeet

Active Member
Hi

I want Copy multiple excel file in 1 excel sheet with file name & sheet name in front of the data.Please give me macro for this
 
Abhijeet, like Faseeh mentioned above you just need to find the forum a bit more....You will get a lot of examples you will just need to change the sheet names and the ranges that are used...

If you want something more specific then please mention the same and then you might get an appropriate solution to it.....
 
Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook
Public strCopyRange As String

Sub GetData()
Dim strWhereToCopy As String, strStartCellColName As String
Dim strListSheet As String
Dim strCopySheet As String

strListSheet = “List”

On Error GoTo ErrH
Sheets(strListSheet).Select
Range(“B2?).Select

‘this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
Set currentWB = ActiveWorkbook
Do While ActiveCell.Value “”

strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
strCopyRange = ActiveCell.Offset(0, 2) & “:” & ActiveCell.Offset(0, 3)
strWhereToCopy = ActiveCell.Offset(0, 4).Value
strCopySheet = ActiveCell.Offset(0, 6).Value
strStartCellColName = Mid(ActiveCell.Offset(0, 5), 2, 1)

Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
Set dataWB = ActiveWorkbook

Sheets(strCopySheet).Select
Range(strCopyRange).Select
Selection.Copy

currentWB.Activate
Sheets(strWhereToCopy).Select
lastRow = LastRowInOneColumn(strStartCellColName)
Cells(lastRow + 1, 1).Select

Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
Application.CutCopyMode = False
dataWB.Close False
Sheets(strListSheet).Select
ActiveCell.Offset(1, 0).Select
Loop
Exit Sub

ErrH:
MsgBox “It seems some file was missing. The data copy operation is not complete.”
Exit Sub
End Sub

Public Function LastRowInOneColumn(col)
‘Find the last used row in a Column: column A in this example
Dim lastRow As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, col).End(xlUp).Row
End With
LastRowInOneColumn = lastRow
End Function

This macro not work
vba-macro-to-copy-data-from-multiple-files.xlsm
Please tell me
 
Please provide the files name, sheets name(also confirm if the sheets have the same name in all files), range to be copied...any more specifications...
 
Here is the code...
1. Goto excel hit alt+F11
2. goto Insert--Module
3. Paste this code there

Code:
Sub Consolidate()
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.ScreenUpdating = False
wb = ActiveWorkbook.Name
drc = Range("A" & Application.Rows.Count).End(xlUp).Row 'defining the last row
For i = 1 To drc 'change this to for i=2 to drc if your range has headers
    wb_bk = Cells(i, 1).Value
    Workbooks.Open (wb_bk)
    wb1 = ActiveWorkbook.Name
    Sheets("Index").Select 'change this to your requirement-sheet you want to copy from
    Range("$A$1:$C$60000").Copy 'change as per requirement
    Windows(wb).Activate
    Sheets(2).Select 'change as per requirement- to paste the data
    drce = Range("A" & Application.Rows.Count).End(xlUp).Select 'defining the last row
    ActiveCell.Offset(1, 0).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Workbooks(wb1).Close False
    Sheets("Index").Select 'change this to your requirement-sheet you want to copy from
Next i
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
 
You should mention all you files that need consolidation in Col.A with full file names (including the path, Filename and file extenstion viz.xls,xlsx,etc...)
Change sheetname and range from the code as per requirements before running the macro...
 
Abhijeet

I want you to follow these instructions.

Make 3 new Excel files, these files should have data, lets say the data is from Col A to C (any length) does not matter and call them

Workbook1.xls
Workbook2.xls
Workbook3.xls

Put three files in a directory, only these 3 files.

Now open a fresh XL File and Paste the following procedure in a regular Module. Make sure you change the Path to the one where the files are saved (don’t forget the backslash \ at the end).


Code:
Option Explicit
Sub OpenName()
    Const sPath = "D:\Test1\"  'Change to suit
    Dim sFil As String
    Dim owbk As Workbook
    Dim ws As Worksheet
 
    sFil = Dir(sPath & "*.xl*")
    Set ws = Sheet1
 
    Do While sFil <> ""
        Set owbk = Workbooks.Open(sPath & sFil)
        Range("A2:C" & Cells(Rows.Count, 3).End(xlUp).Row).Copy ws.Cells(Rows.Count, 1).End(xlUp)(2)
        owbk.Close False 'Close No Savo!
        sFil = Dir
    Loop
End Sub


Now run the procedure.

I can not make this point clear enough –Do not come back to this website till you have tested this simple procedure. If you can’t get the above correct you are in some difficulty as the steps are over simplified. If you can't get this working consider scaling back your project. This is an often asked question and you should be able to grasp it.

Take care Guys

Smallman
 
Back
Top