View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
JLGWhiz JLGWhiz is offline
external usenet poster
 
Posts: 3,986
Default Find specific column titles and copy the column to new workboo

Alrighty, XmansMom, here is something I threw together without testing and
with a lot of guessing. The Path will have to be changed to your actual
path, but leave the *.xls on the end so that it will find all of your Excel
workbooks. Maybe some of the MVPs will help you with this if it does not
work. I think the basics are there.

Sub MoveFiles()
Wkb = Workbook
Set NewBook = Workbooks.Add
With NewBook
.Title = "Archive1"
.Subject = "xls extracts"
.SaveAs Filename:="Archive1.xls"
End With
' modify the path to your configuration
' but leave the *.xls on the end.
MyPath = "C:\Documents and Settings\My Documents\*.xls"
For Each Wkb In MyPath
Workbooks(Wkb.Name & ".xls").Open
For Each sht In ThisWorkbook
With Sheets(sht.Name)
Set c = .Find("UL 94 Rating", LookIn:=xlValues)
If Not c Is Nothing Then
rAddress = c.Address
.Range(rAddress).EntireColumn.Copy
Destination:=Workbooks("Archive1.xls").Worksheets( 1).Cells(Cells(Rows.Count,
1).End(xlUp).Row + 1, 1)
End If
Set c = .Find("Needle Flame", LookIn:=xlValues)
If Not c Is Nothing Then
rAddress = c.Address
.Range(rAddress).EntireColumn.Copy
Destination:=Workbooks("Archive1.xls").Worksheets( 1).Cells(Cells(Rows.Count,
2).End(xlUp).Row + 1, 2)
End If
Set c = .Find("Oxygen Index", LookIn:=xlValues)
If Not c Is Nothing Then
rAddress = c.Address
.Range(rAddress).EntireColumn.Copy
Destination:=Workbooks("Archive1.xls").Worksheets( 1).Cells(Cells(Rows.Count,
3).End(xlUp).Row + 1, 3)
End If
End With
Next sht
Next Wkb
End Sub


"XmansMom" wrote:

No there are no formulas just text in the 3 columns that I need to pull out
of the workbook. But the location of the columns varies depending on the file.

Thanks!
--
DHC


"JLGWhiz" wrote:

Is it safe to assume that there are no formulas in the columns or that the
data is not linked to other locations by relative reference? It either case
exists, then the data will be corrupt when transferred to the new workbook.

"XmansMom" wrote:

Hello: I am trying to write a small script to search through directory
containing a bunch of xls files. It must look at each workbook and if the
column titles "UL 94 Rating" ,"Needle Flame" and "Oxygen Index" are found
then I need to open a new workbook and move these columns to the new
workbook. So essentially I am removing them from the current workbook and
placing them into a new one to preserve the data for future use. If they are
not found in the workbook then I need to close the book and move on to the
next file in the directory. I know how to work on a bunch of files in a
directory but I dont know how to find the specific columns and move them to a
brand new workbook. Any help that you can give is appreciated!