[Last Call] Learn about multicloud storage options and how to improve your company's cloud strategy. Register Now

x
?
Solved

Macro to pull multiple files from a directory

Posted on 2011-03-10
1
Medium Priority
?
349 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

Tech or Treat!

Submit an article about your scariest tech experience—and the solution—and you’ll be automatically entered to win one of 4 fantastic tech gadgets.

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 how to apply various conditional formatting in Excel 2013.
Viewers will learn the basics of slicers and timelines for both PivotTables and standard Excel tables in Excel 2013.

650 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