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