Pumping CSVs into XLSs at one go

[Yarroll]

Hello List!

Is there an easy way to perform the following task?

I have 2 folders on Pulpit. One, "Source", contains CSV files. Second
("Target") holds corresponding Excel Files (XLS). XLS filenames are
identical as CSV (except file extension). Is it possible to pump CSVs into
XLS by some simple macro?

I've been doing in by the following macro:

Dim MyVal As String
MyVal = InputBox("Whereto this time?")

ChDir "c:\windows\pulpit\source"
Workbooks.Open Filename:="c:\windows\pulpit\source\abracadabra01.csv"
Cells.Copy
Workbooks.Open Filename:="c:\windows\pulpit\target\abracadabra01.xls"
Sheets(MyVal).Select
ActiveSheet.Paste
ActiveWorkbook.Save
ActiveWorkbook.Close
ActiveWorkbook.Close

and so on, next CSV-XLS pair. It's OK, only before every such operation I
have to make a new macro to input filenames ("abracadabra", "zebra", etc
etc)
1) first in DOS, dir>list.txt
2) list.txt into Word which adds/replaces etc appropriate lines in this
macro
3) finally macro into Excel.

This seems to be quite a drag, so I'm looking for a macro along this idea:

dim XXX as filename
for each CSV in c:\windows\pulpit\source if there is an XLS counterpart in
c:\windows\pulpit\target, then copy XXX cells into this XLS into a
user-specified (prompt!) worksheet.

I hope I'm making myself clear :-((

Thanks. Best regards
Yarroll

 

[Tom Ogilvy]

I have compiled and executed this code, so it may contain typos, but should
give you an idea how to proceed.

Dim MyVal As String
Dim sPath as String, sPath1 as String
Dim wkbk as Workbook, wkbk1 as Workbook
Dim sName as String, sName1 as String
Dim i as Long
spath = "c:\windows\pulpit\source"
sPath1 = "c:\windows\pulpit\target"
MyVal = InputBox("Whereto this time?")

With Application.FileSearch
.NewSearch
.LookIn = sPath
SearchSubFolders = False
.FileName = ".csv"
.FileType = msoFileTypeAllFiles
End With
If .Execute() > 0 Then
' MsgBox "There were " & .FoundFiles.Count & _
' " file(s) found."
For i = 1 To .FoundFiles.Count
set wkbk = Workbooks.Open .foundfiles(i)
sName = wkbk.Name
sName1 = Left(wkbk.Name,len(wkbk.Name)-3) & "xls"
set wkbk1 = Workbooks.Open sPath1 & "\" & sName1
wkbk.Worksheets(1).Cells.copy _
Destination:= wkbk1.Worksheets(myVal).Cells
wkbk1.Close Savechanges:=True
wkbk.Close Savechanges:=False
Next i
Else
MsgBox "There were no files found."
End If
End With

 

[Yarroll]

Thanks a lot.
This really saves time.
All the best