Copying the Same Range from Multiple Workbooks

I have a series of about 30 workbooks that each contain the same number of worksheets. All of the worksheets share the same name across all of the workbooks and the ranges within each of the worksheets are formatted the same.

I'm looking for VBA code that will allow me to copy the same rows from the same worksheet across all workbooks and paste those rows in subsequent fashion in one workbook.

For instance, say the 30 workbooks all contain one worksheet called "Customer Purchases". I'd like to copy rows 1 and 35 to 44 from each "Customer Purchases" from each of the 30 workbooks and paste these rows into one destination workbook with 30 tabs with each tab representing a respective workbook.

In other words, "Sheet1" in the destination workbook would contain rows 1 and 35 to 44 from the "Customer Purchases" worksheet in workbook 1, "Sheet2" in the destination workbook would contain rows 1 and 35 to 44 from the "Customer Purchases" worksheet in workbook 2, and so on.

Does anyone know how I can do this?

Originally Posted by Leith Ross

Hello Anthony,

Will the copied data overwrite what has been previously copied or appended to it?

Leith,

To answer your question: the data will be copied from each worksheet from the source workbooks to corresponding worksheets in one destination workbook.

The source workbooks are segregated by year and the worksheets within each of the workbooks are similar in format. For example, the "Customer Purchases" worksheets are all similar in format in every one of the 30 workbooks, which again, are denominated by year.

I'd like to get just a handful of rows from each yearly "Customer Purchases" worksheet and paste the values in one destination workbook with 30 tabs, with each tab corresponding to a different year and containing that year's Customer Purchases.

The 30 source workbooks are all contained within a single directory.

Regards,
Tony


Regards,
Tony

For those who are interested, I have poked around the internet and scoured my VBA books to find a solution to my particular problem. Here is what I found:

Option Explicit

Dim wbSourceBook As Workbook, wbDesBook As Workbook
Dim wsSheet As Worksheet
Dim rSourceRange As Range, rDesRange As Range
Dim rNum As Long, i As Long, a As Long, r As Long, z As Long, e As Long, n As Long, m As Long
Dim f As String, Directory As String

Sub ListFiles()

Directory = "D:\YourDirectoryHere\"
Application.DisplayAlerts = False
Application.ScreenUpdating = False

With ActiveSheet
.Cells.ClearContents
.Name = "Master"
End With

r = 1
Cells(r, 1) = "FileName"
Cells(r, 2) = "Size"
Cells(r, 3) = "Date/Time"
f = Dir(Directory & "*.xls")

Do While f <> ""
r = r + 1
Cells(r, 1) = f
Cells(r, 2) = FileLen(Directory & f) & " kb"
Cells(r, 3) = FileDateTime(Directory & f)

f = Dir()
Loop

Call AdjustColumns

End Sub

Sub AdjustColumns()

For Each wsSheet In Application.Worksheets
wsSheet.UsedRange.Cells.Columns.AutoFit
Next wsSheet
End Sub

Sub AddSheetsBasedOnDataYear()

Call ListFiles

z = Cells(Rows.Count, 1).End(xlUp).Row

For e = 2 To z
If ActiveSheet.Cells(e, 1) <> ActiveWorkbook.Name Then
n = InStr(Sheets("Master").Cells(e, 1), "C") + 2
m = Mid(Sheets("Master").Cells(e, 1), n, 4)
Sheets.Add.Name = m
ActiveSheet.Move After:=Worksheets(Worksheets.Count)

Set wbDesBook = ActiveWorkbook
Set wbSourceBook = Workbooks.Open(Directory & Sheets("Master").Cells(e, 1))
Set rSourceRange = wbSourceBook.Worksheets("SourceWb").Range("SourceRng")

MsgBox wbDesBook.ActiveSheet.Name & " data will now be extracted"
With rSourceRange
Set rDesRange = wbDesBook.ActiveSheet.Cells(1, 1). _
Resize(.Rows.Count, .Columns.Count)
End With
rDesRange.Value = rSourceRange.Value
wbSourceBook.Close SaveChanges:=False
End If
Next e

Call AdjustColumns

Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Any comments on my code -- best practices, better efficiency, etc. -- will be appreciated.

Tony

Hi,

I realise this is an old post, but this is similar to my problem..

I have got 77 subfolders within one main folder. Within each of these subfolders are x amount of excel files. I need to copy the range G6:G10 (from sheets named “Score Sheet”) from each of the excel files to one excel sheet in a new workbook.

The range of G6:G10 in each of the excel files (within the subfolders) will be pasted to E2:H2, E3:H3, etc. in the new workbook.

I would appreciate it if you could help!