Copy a Range from each workbook - Ron de Bruin VBA - a problem

  • Thread starter Thread starter Philip
  • Start date Start date
P

Philip

Love this newsgroup! I've been away for a few years, came lokking for help, and didn't even need to ask my question!
Ron de Bruin has the VBA below in his http://www.rondebruin.nl/copy3.htm#Range page, which does what I want to do. Problem is, when the macro gets to <Set mybook = Workbooks.Open(FNames)>, a message tells me my working workbook ("Class Summary") is already open. If I click "yes", nothing further happens. If "No", I am taken to VBA Editor highlighting the aforementioned line. If I then stop the debugging, the process continues to a satifactory conclusion.
As this workbook will be used by less skilled users, I need to resolve this. What am I doing wrong?

I've changed <MyPath> as advised, and have a sheet named "Sheet1" in the workbook. The workbooks from which I want to take the range A4:I30 from sheet1 in each case, are all in the same folder, but may or may not be open: does this matter? It doesn't seem to once I stop the debugger.

Ron's code is below with the changes I've made.

Philip


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

SaveDriveDir = CurDir
MyPath = "D:\Philip's Documents\aPhilip\Keith"
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
rnum = 1

Do While FNames <> ""
Set mybook = Workbooks.Open(FNames)
Set sourceRange = mybook.Worksheets(1).Range("A4:n30")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, "A")

'basebook.Worksheets(1).Cells(rnum, "O").Value = mybook.Name
' This will add the workbook name in column D if you want

sourceRange.Copy destrange
' Instead of this line you can use the code below to copy only the
values

' With sourceRange
' Set destrange = basebook.Worksheets(1).Cells(rnum,"A"). _
' Resize(.Rows.Count, .Columns.Count)
' End With
' destrange.Value = sourceRange.Value

mybook.Close False
rnum = rnum + SourceRcount
FNames = Dir()
Loop
ChDrive SaveDriveDir
ChDir SaveDriveDir
Application.ScreenUpdating = True
End Sub
 
Hi Philip

There is no check in this code example to see if the file is open.
Every file in the folder must be closed
 
Ah! It turns out my summary workbook can't be in the same folder as the files I want to extract the information from. Thanks anyway, Ron, and thanks for the VBA code.

Philip
Hi Philip

There is no check in this code example to see if the file is open.
Every file in the folder must be closed
Philip said:
Love this newsgroup! I've been away for a few years, came looking for help, and didn't even need to ask my question!
Ron de Bruin has the VBA below in his http://www.rondebruin.nl/copy3.htm#Range page, which does what I want to do. Problem is, when the macro gets to <Set mybook = Workbooks.Open(FNames)>, a message tells me my working workbook ("Class Summary") is already open. If I click "yes", nothing further happens. If "No", I am taken to VBA Editor highlighting the aforementioned line. If I then stop the debugging, the process continues to a satifactory conclusion.
As this workbook will be used by less skilled users, I need to resolve this. What am I doing wrong?

I've changed <MyPath> as advised, and have a sheet named "Sheet1" in the workbook. The workbooks from which I want to take the range A4:I30 from sheet1 in each case, are all in the same folder, but may or may not be open: does this matter? It doesn't seem to once I stop the debugger.

Ron's code is below with the changes I've made.

Philip
<snip>
 
Sorry Ron, one more thing:
You have the line
basebook.Worksheets(1).Cells(rnum, "H").Value = mybook.Name
' This will add the workbook name in column D if you want
Which is useful, but it only puts the name in the first row of the range from each workbook: how do I get that value to go in every row of the range from each workbook as part of the macro?

Philip
 
Use this

basebook.Worksheets(1).Cells(rnum, "H").Resize(SourceRcount).Value = mybook.Name
 
Back
Top