View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Bernie Deitrick Bernie Deitrick is offline
external usenet poster
 
Posts: 5,441
Default Searching for and Pasting Data to a new file

Elaine,

Try the macro below. Let me know if it works out OK.

This assumes that "Title" is only found once in the top four rows....

HTH,
Bernie
MS Excel MVP

Option Explicit
Sub FindTitles()
Dim mySht As Worksheet
Dim WorkFile As String
Dim myPath As String
Dim myFind As Range

Set mySht = ActiveSheet
With Application
.DisplayAlerts = False
.ScreenUpdating = False
End With

myPath = "C:\UFBooks\"
WorkFile = Dir(myPath & "*.xls")
Do While WorkFile < ""
Workbooks.Open Filename:=myPath & WorkFile
Set myFind = Range("1:4").Find("Title")
If myFind Is Nothing Then GoTo NotFound
mySht.Cells(Rows.Count, 1).End(xlUp)(2).Value = _
WorkFile
mySht.Cells(Rows.Count, 2).End(xlUp)(2).Value = _
myFind(1, 2).Value
NotFound:
ActiveWorkbook.Close False
WorkFile = Dir()
Loop

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

End Sub


"Elaine" wrote in message
...
I have about 148 files in an Excel directory. Is there an easy way to search
the first four rows of all these files and find the word 'title'. If that
word exists, I would then like to copy the word that is next (the cell to the
right) to that word and paste it in a new file. If the word 'title' is in
cell K4, the actual title will be in L4.

I would then like to copy the contents of the title and the name of the file
(or its path) to a new file called, say, Lists.xls.

Not all files in the directory will contain the word title. All the files
currently reside in C:\UFBooks

If this can be done it would be a huge time saver. Thanks for you help.