Excel Macro for copying data from multiple files in folder to one sheet

[Karanam_teja]

Hi,

I am looking for macro which can help me in copying data of row number 2 to 180 from all 240 excel files(in a folder named 'Data') with the sheet named 'Information' in each file to a single excel Sheet in a separate Master excel file. The data shall be copied to a single sheet in master file, one after another simultaneously so on.


Please help me in this regard, as i was very new to Macros.

Regards,
KT

 

[John_w]

Try this macro in your Master workbook,changing the workbook filespec where shown. The rows are copied to the first sheet in the Master workbook.

Public Sub Copy_Rows_From_Workbooks2()

    Dim fileSpec As String, folderPath As String, fileName As String
    Dim destCell As Range, r As Long
    
    fileSpec = "C:\Data\*.xlsx"        'change folder path and workbook filespec as required
    
    With ThisWorkbook.Worksheets(1)
        .Cells.Clear
        Set destCell = .Range("A1")
        r = 0
    End With
    
    folderPath = Left(fileSpec, InStrRev(fileSpec, "\"))
    
    fileName = Dir(fileSpec)
    Do While Len(fileName) <> 0
        Workbooks.Open folderPath & fileName
        ActiveWorkbook.Worksheets("Information").Rows("2:180").Copy destCell.Offset(r)
        ActiveWorkbook.Close saveChanges:=False
        r = r + 180 - 2 + 1
        fileName = Dir
    Loop
    
    MsgBox "Finished"
    
End Sub

 

[Karanam_teja]

Many Thanks John, it was really helpful. I am facing a problem, the macro is copying formulas rather than values, could you please improve the macro for pasting the 'values' only. (paste values only).
___Thanks!

Try this macro in your Master workbook,changing the workbook filespec where shown. The rows are copied to the first sheet in the Master workbook.

Public Sub Copy_Rows_From_Workbooks2()

    Dim fileSpec As String, folderPath As String, fileName As String
    Dim destCell As Range, r As Long
    
    fileSpec = "C:\Data\*.xlsx"        'change folder path and workbook filespec as required
    
    With ThisWorkbook.Worksheets(1)
        .Cells.Clear
        Set destCell = .Range("A1")
        r = 0
    End With
    
    folderPath = Left(fileSpec, InStrRev(fileSpec, "\"))
    
    fileName = Dir(fileSpec)
    Do While Len(fileName) <> 0
        Workbooks.Open folderPath & fileName
        ActiveWorkbook.Worksheets("Information").Rows("2:180").Copy destCell.Offset(r)
        ActiveWorkbook.Close saveChanges:=False
        r = r + 180 - 2 + 1
        fileName = Dir
    Loop
    
    MsgBox "Finished"
    
End Sub

 

[John_w]

Replace the Copy line with:

        ActiveWorkbook.Worksheets(1).Rows("2:180").Copy
        destCell.Offset(r).PasteSpecial xlPasteValues
        Application.CutCopyMode = False

If you know which source columns are needed you can do it in a single line (destRange.Value = sourceRange.Value) avoiding the above copy/paste via the clipboard.

 

[Karanam_teja]

Many Thanks John, it is working really great!