Copy Spreadsheets with a specific name to another workbook

[JP-2]

Hello Good Folks At VBAX!

Thanks for all the wonderful posts! Actually I have a couple of questions for anyone that can help. They are both similar. I am new to VBA and just started learning so I am currently clueless.

My question is how do I copy spreadsheets with a specific name string from multiple workbooks into a master workbook?

For example, if I had a spreadsheet with a similar name string in 20 different workbooks

parks-mvp
baseball-mvp
dugout-mvp

How can I take all the worksheets that has the "mvp" in the naming string in those different workbooks and dump it into a new workbook named let's say "mvp". So there will be 20 spreadsheets with "mvp" in its name in this one master workbook.

The second question is identical to the first, except, how would I take those same spreadsheets (originally mentioned from the 20 different workbooks) with the "mvp" in the name string and create a new workbook from each individual spreadsheet?

So "parks-mvp" will become its own workbook, "baseball-mvp" will become its own workbook and "dugout-mvp" will become its own workbook.

All the files are sitting in the same folder.

Again, I am totally clueless and was wondering if any of you good folks could assist with either one of these items. if possible.

Thanks a million!

JP-2 (James Pinny)

[mancubus]

hi and wellcome to VBAX.

you may adopt the code from KB article.
http://www.vbaexpress.com/kb/getarticle.php?kb_id=829


Sub CombineFiles()
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=829

Dim path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WS As Worksheet
Dim ThisWB As String

Application.EnableEvents = False
Application.ScreenUpdating = False

ThisWB = ThisWorkbook.Name
path = "C:\Documents\MyFiles\" 'change to suit
FileName = Dir(path & "\*.xls*", vbNormal)

Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each WS In Wkb.Worksheets
If WS.Name Like "*mvp*" Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop

Set Wkb = Nothing

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub

[JP-2]

Thanks Mancubus! I will try it and let you know how it works. Would happen to know how I could modify this to make the worksheets into workbooks instead of combining them into the active workbook?

Thanks again!

[mancubus]

you're wellcome jp-2

try this.

Sub CombineFiles()
'http://www.vbaexpress.com/kb/getarticle.php?kb_id=829

Dim Wkb As Workbook, combWB As Workbook
Dim WS As Worksheet
Dim path As String, FileName As String
Dim ThisWB As String, ffName As String

Application.EnableEvents = False
Application.ScreenUpdating = False

ffName = "C:\Documents\Data_Files\CombinedSheets.xlsx" 'change to suit
ThisWB = ThisWorkbook.Name
path = "C:\Documents\MyFiles\" 'change to suit
FileName = Dir(path & "\*.xls*", vbNormal)

On Error Resume Next
Set combWB = Workbooks(ffName)
On Error GoTo 0
If combWB Is Nothing Then Workbooks.Open ffName

Do Until FileName = ""
If FileName <> ThisWB Then
Set Wkb = Workbooks.Open(FileName:=path & "\" & FileName)
For Each WS In Wkb.Worksheets
If WS.Name Like "*mvp*" Then
WS.Copy After:=Workbooks("CombinedSheets.xlsx").Sheets(Sheets.Count)
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop

Set Wkb = Nothing
Set combWB = Nothing

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub