Hi, I have this code that lists some things and then it saves it in a
user selected folder, and I want to save to the selected folder and
the folder above it. Also, I want after it lists the things it lists
then it rights the name of the "selected" folder you save it in, but
not the folder above it.




Sub fill_file_names()
Dim user_pick As String
Dim r As Integer

Application.DisplayAlerts = False
Workbooks.Add
Range("1:1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("1:1").Select
user_pick = PickFolder("C:\") +
"\*detail*.wk4"
r = 1
next_file = Dir(user_pick)

Do Until next_file = ""
Sheets("Sheet1").Select
Sheets("sheet1").Cells(r, 1) = next_file
next_file = Dir()
r = r + 1
Loop

ActiveWorkbook.SaveAs Filename:="tran.wk4",
FileFormat:=xlWK4, _
CreateBackup:=False
ActiveWorkbook.Save
ActiveWorkbook.Close

Application.DisplayAlerts = True
End Sub

Function PickFolder(strStartDir As Variant) As String
Application.DisplayAlerts = False
Dim SA As Object, f As Object
Set SA = CreateObject("Shell.Application")
Set f = SA.BrowseForFolder(0, "Choose a folder", 0,
strStartDir)
If (Not f Is Nothing) Then
PickFolder = f.Items.Item.Path
End If
Set f = Nothing
Set SA = Nothing
End Function