Copy/Paste Special from Many Files

[Jennifer]

I've got 500 workbooks, all formatted the same. I want to copy 2
columns from each of the workbooks to a new workbook. I'm not sure I
can have 1000 columns in Excel, but I can split the process into
groups. Anyway, I was testing my code with a couple of files and it's
not working. What I end up with is an empty worksheet. Also. must
past special to get just the values, because the workbooks all have
formulas in them. I've never done this particular bit before. Not
sure how it should work. Could someone take a look and help me out
with a suggestion or 3?

Thanks,
Jennifer

Sub MoveCols()
Dim XL As Excel.Application
Dim fso
Dim fol
Dim Col1 As Integer
Dim Col2 As Integer
Dim fil
Dim Unit As String
Set XL = New Excel.Application
Set fso = CreateObject("scripting.Filesystemobject")
Col1 = 2
Col2 = 3
Set fol = fso.getfolder("C:\Out\Audits\Test")


For Each fil In fol.Files
XL.Workbooks.Open (fil.Path)
Unit = Mid(fil.Path, InStr(1, fil.Path, ".") + 1)
XL.Worksheets("Final Plan").Columns("S:T").Select
Selection.Copy
Range(Columns(Col1), Columns(Col2)).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Col1 = Col1 + 2
Col2 = Col2 + 2
Worksheets("Sheet1").Cells(9, Col1).Value = Unit
XL.Quit
Next

End Sub

 

[Jim Cone]

I've taken some liberties with the code. It may or not be close
to what you want.
For instance I changed Unit's value from the file extension to the file name.
I also opened a blank workbook in which to place the data.
The new application remains open and visible - why close it until you
see what happened?
You will have to add code to switch worksheets after 100 + files
have been copied. Excel versions prior to xl2007 have 256 columns.
Also, copying entire columns creates a large file size - that part needs some work.
The code worked twice for me and now I'll let you have some of the fun. <g>
'------------------
Sub MoveCols()
Dim XL As Excel.Application
Dim WB_fil As Excel.Workbook
Dim WB_blank As Excel.Workbook
Dim fso As Object
Dim fol As Object
Dim fil As Object
Dim Col1 As Long
Dim Col2 As Long
Dim Unit As String
Set XL = New Excel.Application
Set fso = CreateObject("scripting.Filesystemobject")
Col1 = 2
Col2 = 3
Set fol = fso.getfolder("C:\Out\Audits\Test")
Set WB_blank = XL.Workbooks.Add

For Each fil In fol.Files
Unit = fil.Name
Set WB_fil = XL.Workbooks.Open(fil.Path)

WB_blank.Worksheets(1).Range(WB_blank.Worksheets(1).Columns(Col1), _
WB_blank.Worksheets(1).Columns(Col2)).Value = _
WB_fil.Worksheets("Final Plan").Columns("S:T").Value
WB_blank.Worksheets(1).Cells(WB_blank.Worksheets(1).Rows.Count, _
Col1).End(xlUp)(2, 1).Value = Unit
Col1 = Col1 + 2
Col2 = Col2 + 2
WB_fil.Close False
Next
XL.Visible = True
Set WB_blank = Nothing
Set WB_fil = Nothing
Set XL = Nothing
Set fso = Nothing
Set fol = Nothing
Set fil = Nothing
End Sub
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware



"Jennifer" <[email protected]>
wrote in message
I've got 500 workbooks, all formatted the same. I want to copy 2
columns from each of the workbooks to a new workbook. I'm not sure I
can have 1000 columns in Excel, but I can split the process into
groups. Anyway, I was testing my code with a couple of files and it's
not working. What I end up with is an empty worksheet. Also. must
past special to get just the values, because the workbooks all have
formulas in them. I've never done this particular bit before. Not
sure how it should work. Could someone take a look and help me out
with a suggestion or 3?
Thanks,
Jennifer

Sub MoveCols()
Dim XL As Excel.Application
Dim fso
Dim fol
Dim Col1 As Integer
Dim Col2 As Integer
Dim fil
Dim Unit As String
Set XL = New Excel.Application
Set fso = CreateObject("scripting.Filesystemobject")
Col1 = 2
Col2 = 3
Set fol = fso.getfolder("C:\Out\Audits\Test")
For Each fil In fol.Files
XL.Workbooks.Open (fil.Path)
Unit = Mid(fil.Path, InStr(1, fil.Path, ".") + 1)
XL.Worksheets("Final Plan").Columns("S:T").Select
Selection.Copy
Range(Columns(Col1), Columns(Col2)).Select
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Col1 = Col1 + 2
Col2 = Col2 + 2
Worksheets("Sheet1").Cells(9, Col1).Value = Unit
XL.Quit
Next
End Sub

 

[Jennifer]

Thanks so much for the help! I had to mod the unit variable only
because I really do want the file extension. The file extension
is not "XLS" on these files. It has been changed to be the unit
number of one of our restaurants. Anyway...thanks for all the help!
I appreciate it.