View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default Copy same range of data from all workbooks and paste into cons

Hi Jeff

Here is a basic example
Copy both (macro and function in a normal module)
Post back if you have problems

Sub TestFile1()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rw As Long
Dim SourceRcount As Long
Dim FNames As String
Dim MyPath As String
Dim SaveDriveDir As String

SaveDriveDir = CurDir
MyPath = "C:\Data"
ChDrive MyPath
ChDir MyPath
FNames = Dir("*.xls")
If Len(FNames) = 0 Then
MsgBox "No files in the Directory"
ChDrive SaveDriveDir
ChDir SaveDriveDir
Exit Sub
End If

Application.ScreenUpdating = False
Set basebook = ThisWorkbook
basebook.Worksheets(1).Cells.Clear
'clear all cells on the first sheet

Do While FNames < ""
Set mybook = Workbooks.Open(FNames)
basebook.Worksheets(1).Cells(LastRow(basebook.Work sheets(1)) + 1, "A").Value = mybook.Name
' This will add the workbook name in column A if you want

For rw = 100 To LastRow(mybook.Sheets(1)) Step 50
Set sourceRange = mybook.Worksheets(1).Rows(rw)
Set destrange = basebook.Worksheets(1).Cells(LastRow(basebook.Work sheets(1)) + 1, "A")
sourceRange.Copy destrange
Next

mybook.Close False
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub

Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function


--
Regards Ron de Bruin
http://www.rondebruin.nl



"Ron de Bruin" wrote in message ...
Hi Jeff

I must go now but will give you a example this evening or tomorrow

--
Regards Ron de Bruin
http://www.rondebruin.nl



"JEFF" wrote in message ...
Thanks again..... Just to push my luck: What if I wanted to copy every 50th
row (starting at row 100) and bring it back to the consolidating workbook?
This would require varying number of rows being copied as the size of the
source workbooks differ.........

Any hope?




"Ron de Bruin" wrote:

I have a example on my site Jeff
http://www.rondebruin.nl/copy3.htm

Or with formulas
http://www.rondebruin.nl/summary2.htm


--
Regards Ron de Bruin
http://www.rondebruin.nl



"JEFF" wrote in message ...
Hi All,

I'd like to be able to go to each workbook in a folder and copy the same
data range from each and paste into a consolidated workbook. For example, go
to each workbook in Folder X, copy the contents in Sheet1 (range A1:A3), and
paste into Consolidated.xls..... This implies that the contents copied from
workbook A would go into row 1, the contents from workbook B would go into
row 2, and so on....

Any help would be greatly appreciated!