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