?
Solved

Macro to pull multiple files from a directory

Posted on 2011-03-10
1
Medium Priority
?
348 Views
Last Modified: 2012-05-11
Hello

Here's the situation.

I have a directory file that has multiple spreadsheets. Each spreadsheet has 3 worksheets within it.
On the second worksheet title "SST" there is data from columns A-I, and a varying amount of rows.

I need a macro that will extract the data from the SST worksheets of all excel files within the directory, and then populate that into a single worksheet.

thanks
Brandon
0
Comment
Question by:KnutsonBM
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 30

Accepted Solution

by:
SiddharthRout earned 2000 total points
ID: 35105920
Untested

Try this. Paste this in a module in the TARGET Excel file where the data has to be imported. This code assumes the following.

1) The file from which the data needs to be extracted is in C:\Temp\
2) The TARGET Excel file is NOT in the folder C:\Temp\
3) The sheet name where you want to import data is called SHEET1 in the TARGET Excel file
4) All sheets are called SST in the files from where the data needs to be extracted.
5) The Column From where the data needs to be extracted is Col A
6) The Destination Col is again Col A in SHEET1

Please amend the above assumptions in the code below before running it :)

Sub Sample()
    Dim wb As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, LastRowWs1 As Long, LastRowWs2 As Long
    Dim foundfile As String, pathoffiles As String
    
    Set ws1 = ActiveWorkbook.Sheets("Sheet1")
    
    '~~> Change path of the directory here
    pathoffiles = "C:\Temp\"
    
    foundfile = Dir(pathoffiles & "*.xls") '<~~~  .xlsx of 2007/2010
    
    Do While Len(foundfile) <> 0
        
        LastRowWs1 = ws1.Range("A" & Rows.Count).End(xlUp).Row
        
        Set wb = Workbooks.Open(pathoffiles & foundfile)
        Set ws2 = wb.Sheets("SST")
        
        LastRowWs2 = ws2.Range("A" & Rows.Count).End(xlUp).Row
        
        ws2.Range("A1:A" & LastRowWs2).Copy ws1.Range("A" & LastRowWs1)
        
        wb.Close savechanges:=False
        
        foundfile = Dir
    Loop

    Set ws2 = Nothing
    Set wb = Nothing
End Sub

Open in new window


Sid
0

Featured Post

Enroll in August's Course of the Month

August's CompTIA IT Fundamentals course includes 19 hours of basic computer principle modules and prepares you for the certification exam. It's free for Premium Members, Team Accounts, and Qualified Experts!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
Viewers will learn the basics about Excel 2013’s new Flash Fill feature.
Viewers will learn the basics of the new Quick Analysis feature in Excel 2013.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question