I got rid of the Select/Selection stuff (but I think I did the same as your
code):

Option Explicit
Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

Dim newName As String

'change to point at the folder to check
myPath = "C:\Documents and Settings\mpethel\My Documents\Excel"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

With ActiveSheet
.Columns("A:F").Delete Shift:=xlToLeft
.Columns("C:C").Cut
.Columns("A:A").Insert Shift:=xlToRight
.Columns("C:C").Cut
.Columns("B:B").Insert Shift:=xlToRight
.Rows("1:1").Delete Shift:=xlUp
End With

'get rid of the .xls extension
newName = Left(tempWkbk.FullName, Len(tempWkbk.FullName) - 4)

'save it as .csv
tempWkbk.SaveAs Filename:=newName, FileFormat:=xlCSV

'close it without saving
tempWkbk.Close savechanges:=False

Next fCtr

End If

End Sub


emt29165 wrote:

Thanks Dave,
I added my code and it works great.
One more question...how can I get them to save in .csv rather than back to
xls?
Here is the complete code as I have it (with mine inserted into yours)....
[thanks again!]

Sub testme01()

Dim tempWkbk As Workbook

Dim myNames() As String
Dim fCtr As Long
Dim myFile As String
Dim myPath As String

'change to point at the folder to check
myPath = "C:\Documents and Settings\mpethel\My Documents\Excel"
If Right(myPath, 1) < "\" Then
myPath = myPath & "\"
End If

myFile = Dir(myPath & "*.xls")
If myFile = "" Then
MsgBox "no files found"
Exit Sub
End If

'get the list of files
fCtr = 0
Do While myFile < ""
fCtr = fCtr + 1
ReDim Preserve myNames(1 To fCtr)
myNames(fCtr) = myFile
myFile = Dir()
Loop

If fCtr 0 Then

For fCtr = LBound(myNames) To UBound(myNames)
Set tempWkbk = Workbooks.Open(Filename:=myPath & myNames(fCtr))

Columns("A:F").Select
Selection.ClearContents
Selection.Delete Shift:=xlToLeft
Columns("C:C").Select
Selection.Cut
Columns("A:A").Select
Selection.Insert Shift:=xlToRight
Columns("C:C").Select
Selection.Cut
Columns("B:B").Select
Selection.Insert Shift:=xlToRight
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select

tempWkbk.Close savechanges:=True

Next fCtr

End If

End Sub

--

Dave Peterson