Excel Macro or other script
Hi Martina,
Apologies for the delay in reponding to your last post. My newsreader
dropped the post and I only spotted it while googling.
The reason that your code is producing a blank summary workbook is that you
have commented out the destination range, thus:
' With sourceRange ' Set destrange =
basebook.Worksheets(1).Cells(rnum, "A"). _
' Resize(.Rows.Count, .Columns.Count) ' End With ' destrange.Value =
sourceRange.Value
Replace your code with the following:
'==================================
Sub Merge2()
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
'MyPath = "C:\Data" or on a network :
MyPath = "\\hvws13\c$\Program Files\CA\" & _
"eTrust Antivirus\DB\" & _
"Excel Files\June05" '<<=== CHECK SPACE after Excel!!!
'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 = MyLastRow(mybook.Worksheets(1))
With mybook.Worksheets(1)
Set sourceRange = Range("A1:B" & LRow)
End With
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook. _
Worksheets(1).Range("A" & rnum)
sourceRange.Copy destrange
rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = True
End Sub
'<<==================================
'==================================
Function MyLastRow(sh As Worksheet)
On Error Resume Next
MyLastRow = sh.Columns("A:B").Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
'<<==================================
Please carefully check the line:
MyPath = "\\hvws13\c$\Program Files\CA\" & _
"eTrust Antivirus\DB\" & _
"Excel Files\June05" '
in the above code as, due to line wrap, I was unable to verify if there
should be a space between 'Excel' and 'Files.
---
Regards,
Norman
|