ExcelTip.com
ExcelTip.com
Account Icon Account Icon Account Icon
Google Exceltip.com
JOIN OUR NEWSLETTER
  and receive for joining:
Free eBook Learn More!
Free Excel ADD-IN
Free Weekly Excel Tip
4 e-books in cd-rom
F1 Formulas & Functions
F1 Formulas & Functions
F1 EXCEL
F1 eBook (Spanish)
F1 EXCEL
Financial Statements.xls
 

» Copy a row or rows from each workbook in a folder using VBA in Microsoft Excel
VBA macro tip contributed by Ron de Bruin, Microsoft MVP - Excel


  • The macro will copy a part of the first worksheet of every file that is in the folder C:\Data to the first worksheet of your workbook.
  • The first macro does a normal copy and second macro copy the values.
Sub CopyRow()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim rnum As Long
    Dim i As Long
    Dim a As Long
    Application.ScreenUpdating = False
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Data"
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            Set basebook = ThisWorkbook
            rnum = 1
            For i = 1 To .FoundFiles.Count
                Set mybook = Workbooks.Open(.FoundFiles(i))
                Set sourceRange = mybook.Worksheets(1).Rows("3:5")
                a = sourceRange.Rows.Count
                Set destrange = basebook.Worksheets(1).Cells(rnum, 1)
                sourceRange.Copy destrange
                mybook.Close
                rnum = i * a + 1
            Next i
        End If
    End With
    Application.ScreenUpdating = True
End Sub

Sub CopyRowValues()
    Dim basebook As Workbook
    Dim mybook As Workbook
    Dim sourceRange As Range
    Dim destrange As Range
    Dim rnum As Long
    Dim i As Long
    Dim a As Long
    Application.ScreenUpdating = False
    With Application.FileSearch
        .NewSearch
        .LookIn = "C:\Data"
        .SearchSubFolders = False
        .FileType = msoFileTypeExcelWorkbooks
        If .Execute() > 0 Then
            Set basebook = ThisWorkbook
            rnum = 1
            For i = 1 To .FoundFiles.Count
                Set mybook = Workbooks.Open(.FoundFiles(i))
                Set sourceRange = mybook.Worksheets(1).Rows("3:5")
                a = sourceRange.Rows.Count
                With sourceRange
                    Set destrange = basebook.Worksheets(1).Cells(rnum, 1). _
                                    Resize(.Rows.Count, .Columns.Count)
                End With
                destrange.Value = sourceRange.Value
                mybook.Close
                rnum = i * a + 1
            Next i
        End If
    End With
    Application.ScreenUpdating = True
End Sub
Rate this tip
12 34 5
  RATING: 4.80
  VIEWS: 12078

READER COMMENTS (view all comments)


No comments have been submitted.


REGISTERED USERS - Click here to post comments


GUESTS (Click here to register)
Name
Comment Title
Comments

The Laws of Money, The Lessons of Life: Keep What You Have and Create What You Deserve

Analysis of Financial Statements

Yes, You Can Time the Market!

Microsoft Office XP Introductory Concepts and Techniques

Financial Peace: Revisited

Keys to Reading an Annual Report (Barron's Business Keys)

RELATED MICROSOFT EXCEL TIPS


Convert PDF Files to Excel


Excel VBA books
Accounting books
Business Plans
MS Office books
Taxes books

VIEW ALL BOOKS