Solved

Macro to pull multiple files from a directory

Posted on 2011-03-10
1
347 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 500 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

[Webinar] Learn How Hackers Steal Your Credentials

Do You Know How Hackers Steal Your Credentials? Join us and Skyport Systems to learn how hackers steal your credentials and why Active Directory must be secure to stop them. Thursday, July 13, 2017 10:00 A.M. PDT

Question has a verified solution.

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

: Microsoft Office Collaborate for free and online versions of Microsoft  Word, Excel, Powerpoint, OneNote, Onedrive , Email, Calendar etc. In short we can say that Microsoft office is a suite of servers, applications and services developed by  Micr…
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
Viewers will learn the basics of using filtering and sorting in Excel 2013.
Viewers will learn the basics of printing in Excel 2013 and how to adjust some common settings.

695 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