Solved

Copy 1 row from every worksheet into a new workbook

Posted on 2011-02-21
5
233 Views
Last Modified: 2012-05-11
I have several excel file is a directory named c:\myreport

I want to copy the range A3:V3

From the tab named "DATA"

To a new worksheet
0
Comment
Question by:cd_morris
5 Comments
 
LVL 85

Expert Comment

by:Rory Archibald
ID: 34943977
Try this:
Sub CopySheetFromFiles()
    Dim wbk As Workbook, wbkThis As Workbook, wks As Worksheet
    Dim strParentFolder As String, strSheetName As String, strFile As String
    
    ' change this to match sheet name you want to copy
    strSheetName = "DATA"
    
    Set wbkThis = Workbooks.Add
    
    strParentFolder = "c:\myreport"
    
    Application.ScreenUpdating = False

    strFile = Dir(strParentFolder & "\*.xls")
   Do Until strFile = ""
      Set wbk = Workbooks.Open(strParentFolder & "\" & strFile)
      Set wks = wbk.Sheets(strSheetName)
      wks.Range("A3:V3").Copy wbkThis.Sheets(1).cells(rows.count, "A").End(xlup).Offset(1)
      wbk.Close False
      strFile = Dir
   Loop
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 34943983
Assuming that you want to do this with every Excel file in that directory...



Sub GrabData()

    Dim fso As Object, fld As Object, fil As Object
    Dim SourceWb As Workbook
    Dim SourceWs As Worksheet
    Dim DestWs As Worksheet
    Dim DestRow As Long
    Dim WbWasOpen As Boolean

    Workbooks.Add
    Set DestWs = ActiveSheet

    Application.ScreenUpdating = False

    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder("c:\myreport")
    For Each fil In fld.Files
        If LCase(fil.Name) Like "*.xls*" Then
            On Error Resume Next
            Set SourceWb = Workbooks(fil.Name)
            If Err = 0 Then
                WbWasOpen = True
            Else
                WbWasOpen = False
                Set SourceWb = Workbooks.Open(fil.Path)
                Err.Clear
            End If
            On Error GoTo 0
            SourceWs = SourceWb.Worksheets("DATA")
            DestRow = DestRow + 1
            SourceWs.[a3:v3].Copy DestWs.Cells(DestRow, 1)
            If Not WbWasOpen Then SourceWb.Close False
        End If
    Next

    Application.ScreenUpdating = True
    MsgBox "Done"

End Sub

Open in new window

0
 
LVL 4

Author Comment

by:cd_morris
ID: 34946046
matthewspatrick Your code gives me arun time error 91 on            
SourceWs = SourceWb.Worksheets("DATA")

0
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 34946166
Sorry, should be:


            Set SourceWs = SourceWb.Worksheets("DATA")

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 34946596
Just a thought - If the input worksheets are the same, and are being updated, or copied into your folder for compilation, you could also create a new workbook, open the source files and directly link to the area you want a copy of.  Then, you just have to open your workbook and update links to refresh the data.

Dave
0

Featured Post

Best Practices: Disaster Recovery Testing

Besides backup, any IT division should have a disaster recovery plan. You will find a few tips below relating to the development of such a plan and to what issues one should pay special attention in the course of backup planning.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
VBA to apply same filter values to multiple tables in Excel 6 35
Dropbox in Windows Server 2008 4 30
Excel Spacing Anomaly 4 23
Select Next Route by Time 4 19
A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Drop Down List with Unique/Distinct Values (Part II - ComboBox or ListBox and Data Validation List Bonus!) David Miller (dlmille) Intro This article focuses on delivering unique, sorted lists to list objects (e.g., ComboBox, ListBox) and Dat…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.

773 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