• 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.

VBA to extract & combine data from multiple excel file from a specific folder

Otherwise help me in this code with little bit error as object required in Ln20, Col 10.

see below code.
Code:
Sub test()

    Dim sPath As String
    Dim sFil As String
    Dim strName As String
    Dim twbk As Workbook
    Dim owbk As Workbook
    Dim ws As Worksheet
    
    Set twbk = ActiveWorkbook
    sPath = "C:\yyyyyyyy\"
    sFil = Dir(sPath & "*.xls")
    
    Do While sFil <> ""
        strName = sPath & sFil
        Set owbk = Workbooks.Open(strName)
        Set ws = owbk.Sheets(1)
        ws.Range("A1", ws.Range("E" & Row.Count).End(xlUp)).Copy twbk.Sheets(1).Range("A" & Rows.Count).End(xlUp)(2)
        owbk.Close False
        sFil = Dir
    Loop
    
    twbk.Save
End Sub
 
Last edited by a moderator:
In this line:
ws.Range("A1", ws.Range("E" & Row.Count).End(xlUp)).Copy twbk.Sheets(1).Range("A" & Rows.Count).End(xlUp)(2)

Bolded bit should be Rows
 
Ooooh!! thanks luke sir :):):)

I hope so but one thing more in this code ,i think it it will extract data from only sheet1 from every workbook of source folder but if workbook have two or more worksheets with data or blank workbook of this folder then will it work for the same?????
 
Last edited:
We can add a quick loop to go through all the worksheets.
Code:
Sub test()

    Dim sPath As String
    Dim sFil As String
    Dim strName As String
    Dim twbk As Workbook
    Dim owbk As Workbook
    Dim ws As Worksheet
   
    Set twbk = ActiveWorkbook
    sPath = "C:\yyyyyyyy\"
    sFil = Dir(sPath & "*.xls")
   
    Do While sFil <> ""
        strName = sPath & sFil
        Set owbk = Workbooks.Open(strName)
        'Loop through all possible worksheets
        For Each ws In owbk.Worksheets
            ws.Range("A1", ws.Range("E" & Rows.Count).End(xlUp)).Copy twbk.Sheets(1).Range("A" & Rows.Count).End(xlUp)(2)
        Next ws
        owbk.Close False
        sFil = Dir
    Loop
   
    twbk.Save
End Sub
 
We can add a quick loop to go through all the worksheets.
Code:
Sub test()

    Dim sPath As String
    Dim sFil As String
    Dim strName As String
    Dim twbk As Workbook
    Dim owbk As Workbook
    Dim ws As Worksheet
  
    Set twbk = ActiveWorkbook
    sPath = "C:\yyyyyyyy\"
    sFil = Dir(sPath & "*.xls")
  
    Do While sFil <> ""
        strName = sPath & sFil
        Set owbk = Workbooks.Open(strName)
        'Loop through all possible worksheets
        For Each ws In owbk.Worksheets
            ws.Range("A1", ws.Range("E" & Rows.Count).End(xlUp)).Copy twbk.Sheets(1).Range("A" & Rows.Count).End(xlUp)(2)
        Next ws
        owbk.Close False
        sFil = Dir
    Loop
  
    twbk.Save
End Sub


thanks
 
Back
Top