Saving Text Delimited to Excel - T. Oglivy
This line is missing a leading period
srcList1 = Workbooks("BookWithList.xls") _
Worksheets("Sheet1").Range("A1").Resize(numFiles,1 ).Value
should be
srcList1 = Workbooks("BookWithList.xls") _
.Worksheets("Sheet1").Range("A1").Resize(numFiles, 1).Value
--
Regards,
Tom Ogilvy
"KENNY" wrote in message
...
Tom,
Thanks a ton! Worked great to get past the Text Delimited
issue. One last thing:
I get a Compile Error: Syntax Error for the following
piece:
srcList1 = Workbooks("Supplant.xls") _
Worksheets("Sheet1").Range("A1").Resize
(numFiles,1).Value
Any clue? The other option was simply pasting those names
into the module, but that seems easier said than done...
-----Original Message-----
Sub RAW_AA()
Dim PathSrc As String, PathDest As String
Dim srcList As Variant
Dim i As Long, sDest As String
Dim bkSrc As Workbook, bkDest As Workbook
Dim srcList1 as Variant, NumFiles as Long
PathSrc = "Y:\Sales\Target Customer\2005 Raw\"
PathDest = "Y:\Sales\Target Customer\2005 Raw - Main\"
NumFiles = 10
workbooks.Open "C:\folder1\BookWithList.xls"
srcList1 = Workbooks("BookWithList.xls") _
Worksheets("Sheet1").Range("A1").Resize
(numFiles,1).Value
workbooks("BookWithList.xls").Close SaveChanges:=False
redim srcList(1 to NumFiles)
for i = 1 to NumFiles
srcList(i) = srcList1(i,1)
Next
'srcList = Array("Raw 1.xls", _
' "Raw 2.xls", _
' "Raw 3.xls", _
' "CO1TR002-02.xls", _
' "CO1TR019-02.xls", _
' "CO1TR028-09.xls", _
' "CO2TR017-02.xls")
For i = LBound(srcList) To UBound(srcList)
Set bkSrc = Workbooks.Open(PathSrc & srcList(i))
sDest = bkSrc.Name
sDest = Left(sDest, Len(sDest) - 4) & "M.xls"
Set bkDest = Workbooks.Open(PathDest & sDest)
bkSrc.Worksheets(1).Rows(1).Resize(50).Copy _
Destination:=bkDest.Worksheets(1).Range("A1")
bkSrc.Close SaveChanges:=False
Application.DisplayAlerts = False
bkDest.SaveAs bkDest.FullName, xlWorkbook
bkDest.Close SaveChanges:=False
Application.DisplayAlerts = True
Next
End Sub
--
Regards,
Tom Ogilvy
"KENNY" wrote in
message
...
In the below, I am copying the first number of rows from
one file and pasting it into another file that shares a
very similar name. It works great with two exceptions:
1. Because it is Tab Delimited, when my code goes to
Save
the destination file, it gets a prompt to "save as", so
I
must manually switch "Save as Type" to Excel, click
save,
and then it prompts me that the file already exists,
and I
must click "OK" to over-write... I'm looking to
automate
this piece....
2. In my SrcList = Array, I have all the names of the
source files I would like included in a separate
spreadsheet, which I tried to paste in, but it doesn't
like it. Any suggestions on how to quickly add file
names
in this manner?
Thanks in advance for any help!
Sub RAW_AA()
Dim PathSrc As String, PathDest As String
Dim srcList As Variant
Dim i As Long, sDest As String
Dim bkSrc As Workbook, bkDest As Workbook
PathSrc = "Y:\Sales\Target Customer\2005 Raw\"
PathDest = "Y:\Sales\Target Customer\2005 Raw - Main\"
srcList = Array("Raw 1.xls", _
"Raw 2.xls", _
"Raw 3.xls", _
"CO1TR002-02.xls", _
"CO1TR019-02.xls", _
"CO1TR028-09.xls", _
"CO2TR017-02.xls")
For i = LBound(srcList) To UBound(srcList)
Set bkSrc = Workbooks.Open(PathSrc & srcList(i))
sDest = bkSrc.Name
sDest = Left(sDest, Len(sDest) - 4) & "M.xls"
Set bkDest = Workbooks.Open(PathDest & sDest)
bkSrc.Worksheets(1).Rows(1).Resize(50).Copy _
Destination:=bkDest.Worksheets(1).Range("A1")
bkSrc.Close SaveChanges:=False
bkDest.Close SaveChanges:=True
Next
End Sub
.
|