Greetings
I need to modify this code slightly. The change I need to make is as
follows... The file that that will be opened has only 1 sheet (as opposed to
several) that is named datayyyymmdd. I need to modify the reference from
Forecast to looking at the first 4 characters of the sheetname or to sheet1.
I tried changing "forecast" to sheet1 and I got a Type Mismatch.

Private Sub CommandButton1_Click()
Dim myCell As Range
Dim myBook As Workbook
Dim i As Long
Dim r As Range, r1 As Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("Forecast").Select
Set r = myBook.Worksheets("Forecast").Range("BP18:BU18")
Set r1 = ThisWorkbook.Worksheets(1). _
Range("B65536").End(xlUp)
If r1.Row = 1 Then Set r1 = r1.Offset(1, 0)
If Not IsEmpty(r1) Then Set r1 = r1.Offset(1, 0)
r.Copy Destination:=r1
myBook.Close SaveChanges:=False
End If ' Instr
End If ' not thisworkbook
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

ThisWorkbook.SaveAs Application.GetSaveAsFilename

End Sub

Thanks!!!

Hi Sandy

You can use something like this

Dim sh As Worksheet
For Each sh In mybook.Worksheets
If Left(sh, 4) = "data" Then
' code
Else
'do nothing
End If
Next


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Sandy" wrote in message ...
Greetings
I need to modify this code slightly. The change I need to make is as
follows... The file that that will be opened has only 1 sheet (as opposed to
several) that is named datayyyymmdd. I need to modify the reference from
Forecast to looking at the first 4 characters of the sheetname or to sheet1.
I tried changing "forecast" to sheet1 and I got a Type Mismatch.

Private Sub CommandButton1_Click()
Dim myCell As Range
Dim myBook As Workbook
Dim i As Long
Dim r As Range, r1 As Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("Forecast").Select
Set r = myBook.Worksheets("Forecast").Range("BP18:BU18")
Set r1 = ThisWorkbook.Worksheets(1). _
Range("B65536").End(xlUp)
If r1.Row = 1 Then Set r1 = r1.Offset(1, 0)
If Not IsEmpty(r1) Then Set r1 = r1.Offset(1, 0)
r.Copy Destination:=r1
myBook.Close SaveChanges:=False
End If ' Instr
End If ' not thisworkbook
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

ThisWorkbook.SaveAs Application.GetSaveAsFilename

End Sub

Thanks!!!

Hi Sandy

Sorry, I see that I forgot .Name

If Left(sh.Name, 4) = "data" Then



--
Regards Ron de Bruin
http://www.rondebruin.nl


"Ron de Bruin" wrote in message ...
Hi Sandy

You can use something like this

Dim sh As Worksheet
For Each sh In mybook.Worksheets
If Left(sh, 4) = "data" Then
' code
Else
'do nothing
End If
Next


--
Regards Ron de Bruin
http://www.rondebruin.nl


"Sandy" wrote in message ...
Greetings
I need to modify this code slightly. The change I need to make is as
follows... The file that that will be opened has only 1 sheet (as opposed to
several) that is named datayyyymmdd. I need to modify the reference from
Forecast to looking at the first 4 characters of the sheetname or to sheet1.
I tried changing "forecast" to sheet1 and I got a Type Mismatch.

Private Sub CommandButton1_Click()
Dim myCell As Range
Dim myBook As Workbook
Dim i As Long
Dim r As Range, r1 As Range

With Application
.DisplayAlerts = False
.EnableEvents = False
.ScreenUpdating = False
End With

With Application.FileSearch
.NewSearch
'Copy or move this workbook to the folder with
'the files that you want to summarize
.LookIn = ThisWorkbook.Path
.FileType = msoFileTypeExcelWorkbooks
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
If .FoundFiles(i) < ThisWorkbook.FullName Then
If InStr(1, .FoundFiles(i), "A.xls", vbTextCompare) Then
Set myBook = Workbooks.Open(.FoundFiles(i))
myBook.Worksheets("Forecast").Select
Set r = myBook.Worksheets("Forecast").Range("BP18:BU18")
Set r1 = ThisWorkbook.Worksheets(1). _
Range("B65536").End(xlUp)
If r1.Row = 1 Then Set r1 = r1.Offset(1, 0)
If Not IsEmpty(r1) Then Set r1 = r1.Offset(1, 0)
r.Copy Destination:=r1
myBook.Close SaveChanges:=False
End If ' Instr
End If ' not thisworkbook
Next i
End If
End With

With Application
.DisplayAlerts = True
.EnableEvents = True
.ScreenUpdating = True
End With

ThisWorkbook.SaveAs Application.GetSaveAsFilename

End Sub

Thanks!!!