Combine Files but only copy certain worksheets

[Shazam]

Hi Everyone


I got this code below from your kb's entry. But I would like to have a condition in the code like some kind of wild card. Is it possible to just only copy worksheets tabs that has the word "Incentive"? Example

[vba]
If Mid(WS.Name, 9) = "Incentive" Then
WS.Copy
End If

[/vba]


I tried to modifief the code but know luck.



[vba]Option Explicit

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet

Application.EnableEvents = False
Application.ScreenUpdating = False
Path = "C:\Production" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

If Mid(WS.Name, 9) = "Incentive" Then
WS.Copy
End If

For Each WS In Wkb.Worksheets
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Next WS
Wkb.Close False
FileName = Dir()
Loop
Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub[/vba]

[Bartek]

Hi,

It seems that the code for the condition is misplaced - it checks for a worksheet from the previously opened, not current file. Try to modify it this way:
[vba]
...
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

For Each WS In Wkb.Worksheets
If Mid(WS.Name, 9) = "Incentive" Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
FileName = Dir()
...
[/vba]

[Shazam]

Hi,

It seems that the code for the condition is misplaced - it checks for a worksheet from the previously opened, not current file. Try to modify it this way:
[vba]
...
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)

For Each WS In Wkb.Worksheets
If Mid(WS.Name, 9) = "Incentive" Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
FileName = Dir()
...
[/vba]

Hi Bartek,



Thank you for replying. I ran your code and nonthing happend. Maybe it's me. The entire worksheet name is:

"Crane Incentive 10-16-2006"

I would like to only copy worksheets that has "Incentive"

Here are some sample files below.

[Bartek]

Hi,

"Crane Incentive 10-16-2006"
I would like to only copy worksheets that has "Incentive"

It that case the Left function will not work - it recognizes only worksheets beginning with "Incentive". You shoud change the contition to:

[vba]If InStr(1, WS.Name, "Incentive") <> 0 Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If[/vba]

[Shazam]

Its giving me a compile error:

"Loop without do"

Here is the code I'm working with.


[VBA]
Option Explicit

Sub CombineFiles()

Dim Path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Application.ScreenUpdating = False
Path = "C:\Production" 'Change as needed
FileName = Dir(Path & "\*.xls", vbNormal)
Do Until FileName = ""
Set Wkb = Workbooks.Open(FileName:=Path & "\" & FileName)


For Each WS In Wkb.Worksheets
If InStr(1, WS.Name, "Incentive") <> 0 Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Wkb.Close False
FileName = Dir()
Loop

Application.ScreenUpdating = True

End Sub

[/VBA]

[Bartek]

Its giving me a compile error:
"Loop without do"

You are missing Next before Wkb.Close - see your original code.

[Shazam]

Than You so much it works great.

I have one question what does this line means?


[VBA]
If InStr(1,
[/VBA]