Multiple Workbooks
 

I've been attempting to use the code, from yesterday's discussion. I need to add multiple workbooks in a particular section however with no luck. This is what I have so far. Thanks

Function Split97(sStr As Variant, sdelim As String) As Variant

Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") & """}")
End Function
Sub SuperGroupTestFile()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Dim vArr As Variant
Dim sFname As String
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "X:\Reports2K\Reports\Daily\sg"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
vArr = Split97(.FoundFiles(i), "\")
sFname = vArr(UBound(vArr))
If Left(sFname, 4) = "SuperGroup_02" Then
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange = mybook.Worksheets(1).Range("D45:T45")
a = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, 1)
sourceRange.Copy destrange
mybook.Close
rnum = rnum + a
End If
Next i
End If
End With
Application.ScreenUpdating = True
End Sub

Multiple Workbooks
 

Ramon,

The most obvious problem that I can see is this line

If Left(sFname, 4) = "SuperGroup_02" Then

you are comparing the leftmost 4 chyaracters of the name against a 13
character string, it will never match.

--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"Ramon" wrote in message
...
I've been attempting to use the code, from yesterday's discussion. I need
to add multiple workbooks in a particular section however with no luck.
This is what I have so far. Thanks

Function Split97(sStr As Variant, sdelim As String) As Variant

Split97 = Evaluate("{""" & _
Application.Substitute(sStr, sdelim, """,""") &
"""}")
End Function
Sub SuperGroupTestFile()
Dim basebook As Workbook
Dim mybook As Workbook
Dim sourceRange As Range
Dim destrange As Range
Dim rnum As Long
Dim i As Long
Dim a As Long
Dim vArr As Variant
Dim sFname As String
Application.ScreenUpdating = False
With Application.FileSearch
.NewSearch
.LookIn = "X:\Reports2K\Reports\Daily\sg"
.SearchSubFolders = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
Set basebook = ThisWorkbook
rnum = 1
For i = 1 To .FoundFiles.Count
vArr = Split97(.FoundFiles(i), "\")
sFname = vArr(UBound(vArr))
If Left(sFname, 4) = "SuperGroup_02" Then
Set mybook = Workbooks.Open(.FoundFiles(i))
Set sourceRange =
mybook.Worksheets(1).Range("D45:T45")
a = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Cells(rnum, 1)
sourceRange.Copy destrange
mybook.Close
rnum = rnum + a
End If
Next i
End If
End With
Application.ScreenUpdating = True
End Sub