ksbcis
10-13-2011, 03:34 PM
Hi All,
I'm trying to consolidate spreadsheets into the active workbook. If the a spreadsheet within a workbook as say "Name A" then copy it into the active workbook. If there is a workbook with "Name A" then import the spreadsheets from that workbook (The workbook "Name A" only has one spreadsheet). It seems like this code is working, but its bombing out at line:
If WB.Name Like "*NameA*" Then
Any ideas as to what needs to be changed here?
Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WB As Workbook
Dim WS As Worksheet
Dim ThisWB As String
Application.EnableEvents = False
Application.ScreenUpdating = False
ThisWB = ThisWorkbook.Name
path = "C:\" '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 "*NameA*" Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Else
If WB.Name Like "*NameA*" Then
WB.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Set Wkb = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
I'm trying to consolidate spreadsheets into the active workbook. If the a spreadsheet within a workbook as say "Name A" then copy it into the active workbook. If there is a workbook with "Name A" then import the spreadsheets from that workbook (The workbook "Name A" only has one spreadsheet). It seems like this code is working, but its bombing out at line:
If WB.Name Like "*NameA*" Then
Any ideas as to what needs to be changed here?
Sub CombineFiles()
Dim path As String
Dim FileName As String
Dim Wkb As Workbook
Dim WB As Workbook
Dim WS As Worksheet
Dim ThisWB As String
Application.EnableEvents = False
Application.ScreenUpdating = False
ThisWB = ThisWorkbook.Name
path = "C:\" '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 "*NameA*" Then
WS.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
Else
If WB.Name Like "*NameA*" Then
WB.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
End If
End If
Next WS
Wkb.Close False
End If
FileName = Dir()
Loop
Set Wkb = Nothing
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub