Workbook Condensing Problem

[Guest]

I have this below function from a contributer here, however I am having a
problem. It is not doing as it should. I have copy/pasted the module below.
Basically it looks like it is opening each of the files in the folder and
when it should copy the first sheet onto the base workbook it is not.

Any advice?


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


Sub Example8()
Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim lrow As Long

'Fill in the path\folder where the files are
'on your machine : MyPath = "C:\Data" or on a network :
MyPath = "C:\Documents and Settings\fazalh\Desktop\Data"

'Add a slash at the end if the user forget it
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If

'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xls")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If

On Error GoTo CleanUp

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

'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0

Do While FilesInPath <> ""
Fnum = Fnum + 1
ReDim Preserve MyFiles(1 To Fnum)
MyFiles(Fnum) = FilesInPath
FilesInPath = Dir()
Loop

'Loop through all files in the array(myFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
lrow = LastRow(mybook.Sheets(1))

Set sourceRange = mybook.Worksheets(1).Range("A2:IV" & lrow)
'Copy from A2:IV? (till the last row with data on your sheet)
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Range("A" & rnum)

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

rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub


Any help would be very much appreciated.

Thank you very much,

H

 

[Dave Peterson]

Ron's code worked for me.

But I could break it if my first sheet in the workbook wasn't a worksheet (like
a chart sheet) or if the first sheet didn't have any data on it. (the LastRow
function returned 0)

You may want to do a little more debugging (stepping through the code???).