Open file macro
 

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!!!

Open file macro
 

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!!!

Open file macro
 

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!!!