JLGWhiz
12/12/2006 8:40:00 PM
Well, I modified the code you posted so that it will paste to the new
workbook. But the loop you had set up would not step through the different
sheets or workbooks, so I took it out for testing purposes to get the paste
to work. The code below will find and paste all three header columns for one
iteration. The problem with the paste was that the code was copying the
entire column but was telling it to paste in less space. It won't do that.
A work aroung is to locate the last row, activate the cell below that in the
column to be pasted and then use the paste command. You can find the last
row with:
LR = Cells(Rows.Count,ColumnNumberTo Paste).End(xlUp).Row
Then to activate the next cell down:
Cells(LR + 1,ColumnNumberToPaste).Activate
The problem with this is you will have to jump back and forth between
workbooks to copy and paste which slows the whole process. Anyhow, here is
the modified code for you to play with.
Sub cpyCol()
Set NewBook = Workbooks.Add
With NewBook
..Title = "Archive1"
..Subject = "xls extracts"
..SaveAs Filename:="Archive1.xls"
End With
sName = Dir((Pathname) & "VV*.xls") 'get the filename
Workbooks.Open Filename:=(Pathname) & (sName)
With Workbooks(sName).Worksheets(1).Cells
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(1, 1)
End If
End With
With Workbooks(sName).Worksheets(1).Cells
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(1, 2)
End If
End With
With Workbooks(sName).Worksheets(1).Cells
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(1, 3)
End If
End With
sName = Dir()
End Sub
"XmansMom" wrote:
> Hi: Thanks for trying to help :) I have been playing around with some things
> and I got the code below to compile and run but it will not write out the
> columns to the new Archive1 spreadsheet. Any ideas where I am going wrong (I
> am using Office 2003). Thanks!
>
>
> Set NewBook = Workbooks.Add
> With NewBook
> .Title = "Archive1"
> .Subject = "xls extracts"
> .SaveAs Filename:="Archive1.xls"
> End With
>
> sName = Dir((Pathname) & "VV*.xls") 'get the filename
>
> Do While sName <> ""
> Workbooks.Open Filename:= _
> (Pathname) & (sName)
> Cells.Select
> Set c = Selection.Find("UL 94 Rating", LookIn:=xlValues)
> If Not c Is Nothing Then
> rAddress = c.Address
> Selection.Range(rAddress).EntireColumn.Copy
> Destination =
> Workbooks("Archive1.xls").Worksheets(1).Cells(Cells(Rows.Count,
> 1).End(xlUp).Row + 1, 1)
> End If
> Set c = Selection.Find("Needle Flame", LookIn:=xlValues)
> If Not c Is Nothing Then
> rAddress = c.Address
> Selection.Range(rAddress).EntireColumn.Copy
> Destination =
> Workbooks("Archive1.xls").Worksheets(1).Cells(Cells(Rows.Count,
> 2).End(xlUp).Row + 1, 2)
> End If
> Set c = Selection.Find("Oxygen Index", LookIn:=xlValues)
> If Not c Is Nothing Then
> rAddress = c.Address
> Selection.Range(rAddress).EntireColumn.Copy
> Destination =
> Workbooks("Archive1.xls").Worksheets(1).Cells(Cells(Rows.Count,
> 3).End(xlUp).Row + 1, 3)
> End If
>
> sName = Dir()
> Loop
> End Sub
>
> --
> DHC
>
>
> "JLGWhiz" wrote:
>
> > Disregard that code. I finally set up a test and it is not what you need,
> > plus the method is the wrong type to return the files properly. It needs to
> > be a file search method, to return your files that will be copied. It is a
> > little more complex than I first thought.
> >
> > "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!
> > > > >