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
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