S
sc
I am using Excel 2002. I am wanting to open all .xls files in a directory
check to see if it contains a specific text and then paste the filename in a
cell if it contains that text. Everything is working except the file name is
being pasted in the cells even if the file does not contain the text.
I have used some code I got from the internet to loop through all of the
files and open them and the paste all the files names in cells.
Here is the code I added:
With mybook.Worksheets(1)
Set c = .Find("Adam")
End With
If c = "Adam" Then
Here is all of the code put together:
'now we can open the files in the array MyFiles to do what we want
On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
'start row for the info from the first file
rnum = 1
'loop through all files in the array (MyFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))
Set sourceRange = mybook.Worksheets(1).Range("a1:c1")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Range("A" & rnum)
'This will add the workbook name in column D if you want
basebook.Worksheets(1).Cells(rnum, "D").Value = MyFiles(Fnum)
With mybook.Worksheets(1)
Set c = .Find("Adam")
End With
If c = "Adam" Then
sourceRange.Copy destrange
End If
rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = False
Any help would be appreciated.
check to see if it contains a specific text and then paste the filename in a
cell if it contains that text. Everything is working except the file name is
being pasted in the cells even if the file does not contain the text.
I have used some code I got from the internet to loop through all of the
files and open them and the paste all the files names in cells.
Here is the code I added:
With mybook.Worksheets(1)
Set c = .Find("Adam")
End With
If c = "Adam" Then
Here is all of the code put together:
'now we can open the files in the array MyFiles to do what we want
On Error GoTo CleanUp
Application.ScreenUpdating = False
Set basebook = ThisWorkbook
'clear all cells on the first sheet
basebook.Worksheets(1).Cells.Clear
'start row for the info from the first file
rnum = 1
'loop through all files in the array (MyFiles)
If Fnum > 0 Then
For Fnum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Workbooks.Open(MyFiles(Fnum))
Set sourceRange = mybook.Worksheets(1).Range("a1:c1")
SourceRcount = sourceRange.Rows.Count
Set destrange = basebook.Worksheets(1).Range("A" & rnum)
'This will add the workbook name in column D if you want
basebook.Worksheets(1).Cells(rnum, "D").Value = MyFiles(Fnum)
With mybook.Worksheets(1)
Set c = .Find("Adam")
End With
If c = "Adam" Then
sourceRange.Copy destrange
End If
rnum = rnum + SourceRcount
mybook.Close savechanges:=False
Next Fnum
End If
CleanUp:
Application.ScreenUpdating = False
Any help would be appreciated.