PDA

View Full Version : Combine Files but only copy certain worksheets



Shazam
10-26-2006, 06:19 AM
Hi Everyone:hi:


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


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




I tried to modifief the code but know luck.



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

Bartek
10-26-2006, 06:33 AM
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:

...
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()
...

Shazam
10-26-2006, 06:49 AM
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:

...
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()
...



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
10-26-2006, 06:57 AM
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:

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

Shazam
10-26-2006, 07:05 AM
Its giving me a compile error:

"Loop without do"

Here is the code I'm working with.



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

Bartek
10-26-2006, 07:31 AM
Its giving me a compile error:
"Loop without do"

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

Shazam
10-26-2006, 07:59 AM
Than You so much it works great.

I have one question what does this line means?



If InStr(1,