source sheet name as a wild card

[James]

I was working on this late last night, than I remembered Ron de Bruin page
and he had some written for what I needed. I need a small modification on
this code. In the SourceShName line I have it pulling all sheets with the
name "Report", but some are my sheet names are called "Report 1, Report 2..."
How can I make it look for anything called Report* or something like that.

Sub RDB_Copy_Sheet()
Dim myFiles As Variant
Dim myCountOfFiles As Long

myCountOfFiles = Get_File_Names( _
MyPath:="H:\myprojdir\GWIS\Humble\Test\part2", _
Subfolders:=True, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Sheet _
PasteAsValues:=True, _
SourceShName:="Repor*", _
SourceShIndex:=1, _
myReturnedFiles:=myFiles

End Sub

Thanks

 

[Barb Reinhardt]

You can do something like this

Dim WS as Excel.worksheet
Dim WB as Excel.Workbook

Set WB = ThisWorkbook

For each WS in WB.Worksheets
If WS.Name Like "Report*" then
'Do what you want to do
End iF
next WS

Hope that helps.

Barb Reinhardt

 

[ryguy7272]

This is how I do it:
Application.DisplayAlerts = False
Dim sh As Worksheet

For Each sh In ActiveWorkbook.Worksheets
If InStr(1, sh.Name, "Sheet1") Then
sh.Select False
Else
sh.Delete
End If
Next sh
Application.DisplayAlerts = True

Anything with Sheet1 in the name will be ignored; Sheet1, Sheet11, Sheet111,
etc.

HTH,
Ryan---

 

[Rick Rothstein]

My guess is the answer to your question lies in the code you did not show
us. Neither Get_File_Names nor Get_Sheet are built into VB, so I am guessing
they are subroutines that are being called upon to do the "real" work of
your code... we would need to see their code.

 

[James]

Barb,
Thanks for looking into this for me, I placed your portion of the code where
I thought it should go but now it is not pulling anything out. Here is what
the code looks like now:
Sub RDB_Copy_Sheet()
Dim myFiles As Variant
Dim myCountOfFiles As Long

Dim WS As Excel.Worksheet
Dim WB As Excel.Workbook
Set WB = ThisWorkbook

For Each WS In WB.Worksheets
If WS.Name Like "Report*" Then

myCountOfFiles = Get_File_Names( _
MyPath:="H:\myprojdir\GWIS\Humble\Test\part2", _
Subfolders:=True, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Sheet _
PasteAsValues:=True, _
SourceShName:="Report", _
SourceShIndex:=1, _
myReturnedFiles:=myFiles
End If
Next WS


End Sub

Any suggestions??
Thanks

 

[James]

Rick you are correct, I started looking into the other modules and here is
the complete code for the othe subs that are being called:
Sub RDB_Copy_Sheet()
Dim myFiles As Variant
Dim myCountOfFiles As Long


myCountOfFiles = Get_File_Names( _
MyPath:="H:\myprojdir\GWIS\Humble\Test\part2", _
Subfolders:=True, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Sheet _
PasteAsValues:=True, _
SourceShName:="Report*", _
SourceShIndex:=1, _
myReturnedFiles:=myFiles


End Sub


' Note: You not have to change the macro below, you only
' edit and run the RDB_Copy_Sheet above.

Sub Get_Sheet(PasteAsValues As Boolean, SourceShName As String, _
SourceShIndex As Integer, myReturnedFiles As Variant)
Dim mybook As Workbook, BaseWks As Worksheet
Dim CalcMode As Long
Dim SourceSh As Variant
Dim sh As Worksheet
Dim I As Long

'Change ScreenUpdating, Calculation and EnableEvents
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With

On Error GoTo ExitTheSub

'Add a new workbook with one sheet
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)


'Check if we use a named sheet or the index
If SourceShName = "" Then
SourceSh = SourceShIndex
Else
SourceSh = SourceShName
End If

'Loop through all files in the array(myFiles)
For I = LBound(myReturnedFiles) To UBound(myReturnedFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(myReturnedFiles(I))
On Error GoTo 0

If Not mybook Is Nothing Then

'Set sh and check if it is a valid
On Error Resume Next
Set sh = mybook.Sheets(SourceSh)

If Err.Number > 0 Then
Err.Clear
Set sh = Nothing
End If
On Error GoTo 0

If Not sh Is Nothing Then
sh.Copy
after:=BaseWks.Parent.Sheets(BaseWks.Parent.Sheets.Count)

On Error Resume Next
ActiveSheet.Name = mybook.Name
On Error GoTo 0

If PasteAsValues = True Then
With ActiveSheet.UsedRange
.Value = .Value
End With
End If

End If
'Close the workbook without saving
mybook.Close savechanges:=False
End If

'Open the next workbook
Next I

' delete the first sheet in the workbook
Application.DisplayAlerts = False
On Error Resume Next
BaseWks.Delete
On Error GoTo 0
Application.DisplayAlerts = True

ExitTheSub:
'Restore ScreenUpdating, Calculation and EnableEvents
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub

--------------------------------

Option Explicit

Private myFiles() As String
Private Fnum As Long

Function Get_File_Names(MyPath As String, Subfolders As Boolean, _
ExtStr As String, myReturnedFiles As Variant) As Long

Dim Fso_Obj As Object, RootFolder As Object
Dim SubFolderInRoot As Object, file As Object

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

'Create FileSystemObject object
Set Fso_Obj = CreateObject("Scripting.FileSystemObject")

Erase myFiles()
Fnum = 0

'Test if the folder exist and set RootFolder
If Fso_Obj.FolderExists(MyPath) = False Then
Exit Function
End If
Set RootFolder = Fso_Obj.GetFolder(MyPath)

'Fill the array(myFiles)with the list of Excel files in the folder(s)
'Loop through the files in the RootFolder
For Each file In RootFolder.Files
If LCase(file.Name) Like LCase(ExtStr) Then
Fnum = Fnum + 1
ReDim Preserve myFiles(1 To Fnum)
myFiles(Fnum) = MyPath & file.Name
End If
Next file

'Loop through the files in the Sub Folders if SubFolders = True
If Subfolders Then
Call ListFilesInSubfolders(OfFolder:=RootFolder, FileExt:=ExtStr)
End If

myReturnedFiles = myFiles
Get_File_Names = Fnum
End Function

 

[James]

Barb,
on one my later post on this I provided the other subs that maybe the cause
of the problem.

Thanks,

 

[James]

Barb,
On my reply at the end you can see the other subs that are being called in
on this macro. I think that might be the cause of the problem too.

Thanks

 

[Ron de Bruin]

I add this option to my add-in
http://www.rondebruin.nl/merge.htm


--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm

I was working on this late last night, than I remembered Ron de Bruin page
and he had some written for what I needed. I need a small modification on
this code. In the SourceShName line I have it pulling all sheets with the
name "Report", but some are my sheet names are called "Report 1, Report 2..."
How can I make it look for anything called Report* or something like that.

Sub RDB_Copy_Sheet()
Dim myFiles As Variant
Dim myCountOfFiles As Long

myCountOfFiles = Get_File_Names( _
MyPath:="H:\myprojdir\GWIS\Humble\Test\part2", _
Subfolders:=True, _
ExtStr:="*.xl*", _
myReturnedFiles:=myFiles)

If myCountOfFiles = 0 Then
MsgBox "No files that match the ExtStr in this folder"
Exit Sub
End If

Get_Sheet _
PasteAsValues:=True, _
SourceShName:="Repor*", _
SourceShIndex:=1, _
myReturnedFiles:=myFiles

End Sub

Thanks

__________ Information from ESET Smart Security, version of virus signature database 3957 (20090324) __________

The message was checked by ESET Smart Security.

http://www.eset.com

__________ Information from ESET Smart Security, version of virus signature database 3958 (20090324) __________

The message was checked by ESET Smart Security.

http://www.eset.com