combine excel spreadsheet data into another file

Posted on 2011-10-21
Last Modified: 2012-06-21
I have 25 individual excel spreadsheets and I want to put the data from Cells B3, B4 and A2 in each sheet into a list in another excel spreadsheet.  How would I do that using VBS?
Question by:Dier02
    LVL 3

    Accepted Solution


    I happened to have a similar worksheet as in your request.
    I tweaked it a little for your needs.

    If you open the attach you'll see a field Path and a field SheetName
    In field Path you should copy the location of your 25 files.
    In field SheetName you should enter the name of the sheet from which you want the values B3, B4 and A2 to be copied.

    So, in order to make this code work for you. You should place all 25 files in one folder. The names of the sheets to collect the data from should be the same.

    Hope this works for you.



    Author Comment

    c Sub ListWorkbooks()
       Dim Directory As String
       Dim FileName As String
       Dim IndexSheet As Worksheet
       Dim rw As Long
       Directory = "" & Range("Path").Value & ""
       If Left(Directory, 1) <> "\" Then
           Directory = Directory & "\"
       End If
       rw = 10
       Set IndexSheet = ThisWorkbook.ActiveSheet
       FileName = Dir(Directory & "*")
       Do While FileName <> ""
           IndexSheet.Cells(rw, 2).Formula = "='" & Directory & "[" & FileName & "]" & Range("SheetName").Value & "'!A3"
           IndexSheet.Cells(rw, 2).Copy
           IndexSheet.Cells(rw, 2).PasteSpecial Paste:=xlPasteValues
           IndexSheet.Cells(rw, 3).Formula = "='" & Directory & "[" & FileName & "]" & Range("SheetName").Value & "'!C1"
           IndexSheet.Cells(rw, 2).Copy
           IndexSheet.Cells(rw, 2).PasteSpecial Paste:=xlPasteValues
           IndexSheet.Cells(rw, 4).Formula = "='" & Directory & "[" & FileName & "]" & Range("SheetName").Value & "'!C2"
           IndexSheet.Cells(rw, 2).Copy
           IndexSheet.Cells(rw, 2).PasteSpecial Paste:=xlPasteValues
           rw = rw + 1
           FileName = Dir
       Set IndexSheet = Nothing
    End Sub


    Author Comment

    This line is throwing an exception:

    IndexSheet.Cells(rw, 2).Formula = "='" & Directory & "[" & FileName & "]" & Range("SheetName").Value & "'!A3"

    Also - as you can see on the sheet labelled ScoreCode there are a range of values across the bottom that signify spelling levels.  I also want to include across the rows each of these levels as a student could be in one or more levels - i.e LNAL and in SAE.

    Featured Post

    How to run any project with ease

    Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
    - Combine task lists, docs, spreadsheets, and chat in one
    - View and edit from mobile/offline
    - Cut down on emails

    Join & Write a Comment

    How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
    Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
    The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
    This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.

    755 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

    Need Help in Real-Time?

    Connect with top rated Experts

    19 Experts available now in Live!

    Get 1:1 Help Now